CAD开发者社区

 找回密码
 立即注册

QQ登录

只需一步,快速开始

ActiveX 开发指南

相关分类

MoveToBottom Method (ActiveX)

2023-1-4 05:17| 发布者: admin| 查看: 659| 评论: 0|来自: AutoCAD

摘要: 将对象移动到绘制顺序的底部。

将对象移动到绘制顺序的底部。

支持的平台:仅窗口

签名

工 务 局:

object.MoveToBottom Objects
对象

类型:排序表

此方法适用的对象。

对象

访问:仅输入

类型:变体

要移动的对象。

返回值(RetVal)

无返回值。

言论

没有额外的评论。

例子

工 务 局:

Sub Example_SortentsTable()
    ' This example creates a SortentsTable object and
    ' changes the draw order.

    ' Set drawing to display lineweights and create a True Color object
    Dim ACADPref As AcadDatabasePreferences
    Set ACADPref = ThisDrawing.preferences
    ACADPref.LineWeightDisplay = True
    Dim MyColorObjOne As AcadAcCmColor
    Set MyColorObjOne = AcadApplication.GetInterfaceObject("AutoCAD.AcCmColor." & Left(AcadApplication.Version, 2))
    Call MyColorObjOne.SetRGB(80, 100, 244)
   
    ' Draw a polyline
    Dim plineObj As AcadPolyline
    Dim points(0 To 8) As Double
    points(0) = 4: points(1) = 4: points(2) = 0
    points(3) = 3: points(4) = 5: points(5) = 0
    points(6) = 6: points(7) = 20: points(8) = 0
    Set plineObj = ThisDrawing.ModelSpace.AddPolyline(points)
    plineObj.Lineweight = acLnWt211
    Call MyColorObjOne.SetRGB(90, 110, 150)
    plineObj.TrueColor = MyColorObjOne

    ' Draw a line
    Dim lineObj As AcadLine
    Dim startPoint(0 To 2) As Double
    Dim endPoint(0 To 2) As Double
    startPoint(0) = 5: startPoint(1) = 13: startPoint(2) = 0
    endPoint(0) = 5: endPoint(1) = 27: endPoint(2) = 0
    Set lineObj = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)
    lineObj.Lineweight = acLnWt211
    Call MyColorObjOne.SetRGB(50, 80, 230)
    lineObj.TrueColor = MyColorObjOne
     
    ' Draw a circle
    Dim circleObj As AcadCircle
    Dim centerPoint(0 To 2) As Double
    Dim radius As Double
    centerPoint(0) = 10: centerPoint(1) = 15: centerPoint(2) = 0#
    radius = 5#
    Set circleObj = ThisDrawing.ModelSpace.AddCircle(centerPoint, radius)
    circleObj.Lineweight = acLnWt211
    Call MyColorObjOne.SetRGB(60, 200, 220)
    circleObj.TrueColor = MyColorObjOne
    ZoomAll
    AcadApplication.Update
      
    ' Get an extension dictionary and, if necessary, add a SortentsTable object
    Dim eDictionary As Object
    Set eDictionary = ThisDrawing.ModelSpace.GetExtensionDictionary
    ' Prevent failed GetObject calls from throwing an exception
    On Error Resume Next
    Dim sentityObj As Object
    Set sentityObj = eDictionary.GetObject("ACAD_SORTENTS")
    On Error GoTo 0
    If sentityObj Is Nothing Then
         ' No SortentsTable object, so add one
         Set sentityObj = eDictionary.AddObject("ACAD_SORTENTS", "AcDbSortentsTable")
    End If
    
    Dim ObjIds(2) As Long
    ObjIds(0) = plineObj.ObjectID
    ObjIds(1) = lineObj.ObjectID
    ObjIds(2) = circleObj.ObjectID
    
    Dim varObject As AcadObject
    Set varObject = ThisDrawing.ObjectIdToObject(ObjIds(2))
    Dim arr(0) As AcadObject
    Set arr(0) = varObject
    
    ' Move the circle object to the bottom
    sentityObj.MoveToBottom arr
    AcadApplication.Update
         
End Sub

Visual LISP:

(vl-load-com)
(defun c:Example_SortentsTable()
    ;; This example creates a SortentsTable object and
    ;; changes the draw order.
    (setq acadObj (vlax-get-acad-object))
    (setq doc (vla-get-ActiveDocument acadObj))
    (setq modelSpace (vla-get-ModelSpace doc))

    ;; Set drawing to display lineweights and create a True Color object
    (vla-put-LineWeightDisplay (vla-get-Preferences doc) :vlax-true)
    (setq MyColorObjOne (vlax-create-object (strcat "AutoCAD.AcCmColor." (substr (getvar "ACADVER") 1 2))))
    (vla-SetRGB MyColorObjOne 80 100 244)
   
    ;; Draw a polyline
    (setq points (vlax-make-safearray vlax-vbDouble '(0 . 8)))
    (vlax-safearray-fill points '(4 4 0
                                  3 5 0
                                  6 20 0
                                 )
    )

    (setq plineObj (vla-AddPolyline modelSpace points))

    (vla-put-Lineweight plineObj acLnWt211)
    (vla-SetRGB MyColorObjOne 90 110 150)
    (vla-put-TrueColor plineObj MyColorObjOne)

    ;; Draw a line
    (setq startPoint (vlax-3d-point 5 13 0)
          endPoint (vlax-3d-point 5 27 0))

    (setq lineObj (vla-AddLine modelSpace startPoint endPoint))
    (vla-put-Lineweight lineObj acLnWt211)
    (vla-SetRGB MyColorObjOne 50 80 230)
    (vla-put-TrueColor lineObj MyColorObjOne)
     
    ;; Draw a circle
    (setq centerPoint (vlax-3d-point 10 15 0)  
          radius 5)

    (setq circleObj (vla-AddCircle modelSpace centerPoint radius))
    (vla-put-Lineweight circleObj acLnWt211)
    (vla-SetRGB MyColorObjOne 60 200 220)
    (vla-put-TrueColor circleObj MyColorObjOne)

    (vla-ZoomAll acadObj)
    (vla-Update acadObj)
      
    ;; Get an extension dictionary and, if necessary, add a SortentsTable object
    (setq eDictionary (vla-GetExtensionDictionary modelSpace))

    ;; Prevent failed GetObject calls from throwing an exception
    (setq sentityObj (vl-catch-all-apply 'vla-GetObject (list eDictionary "ACAD_SORTENTS")))
  
    (if (= (type sentityObj)'VL-CATCH-ALL-APPLY-ERROR)
         ;; No SortentsTable object, so add one
         (setq sentityObj (vla-AddObject eDictionary "ACAD_SORTENTS" "AcDbSortentsTable"))
    )
    
    (setq ObjIds (vlax-make-safearray vlax-vbLong '(0 . 2)))
    (vlax-safearray-put-element ObjIds 0 (vla-get-ObjectID plineObj))
    (vlax-safearray-put-element ObjIds 1 (vla-get-ObjectID lineObj))
    (vlax-safearray-put-element ObjIds 2 (vla-get-ObjectID circleObj))
    
    (setq varObject circleObj)
    (setq arr (vlax-make-safearray vlax-vbObject '(0 . 0)))
    (vlax-safearray-put-element arr 0 varObject)
    
    ;; Move the circle object to the bottom
    (vla-MoveToBottom sentityObj arr)
    (vla-Update acadObj)

    (vlax-release-object MyColorObjOne)
)

路过

雷人

握手

鲜花

鸡蛋

最新评论

QQ|Archiver|CAD开发者社区 ( 苏ICP备2022047690号-1 )

GMT+8, 2024-5-11 19:29

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

返回顶部