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? |
The server encountered an internal error or misconfiguration and was unable to complete your request.
Please contact the server administrator at webmaster@entercad.forsenergy.ru to inform them of the time this error occurred, and the actions you performed just before this error.
More information about this error may be available in the server error log.
Additionally, a 500 Internal Server Error error was encountered while trying to use an ErrorDocument to handle the request.