SortentsTable Example |
Using Programming Languages other than VBA
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
Comments? |