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? 
500 Internal Server Error

Internal Server Error

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.