- 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.16")
- 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
-
- 'Gxet 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
|