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?