Returns the block of a SortentsTable object.
No additional remarks.
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.20")
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
' Get 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
Visual LISP:
(vl-load-com)
(defun c:Example_SortentsTable()
;; This example creates a SortentsTable object and
;; changes the draw order.
(setq acadObj (vlax-get-acad-object))
(setq doc (vla-get-ActiveDocument acadObj))
(setq modelSpace (vla-get-ModelSpace doc))
;; Set drawing to display lineweights and create a True Color object
(vla-put-LineWeightDisplay (vla-get-Preferences doc) :vlax-true)
(setq MyColorObjOne (vlax-create-object "AutoCAD.AcCmColor.20"))
(vla-SetRGB MyColorObjOne 80 100 244)
;; Draw a polyline
(setq points (vlax-make-safearray vlax-vbDouble '(0 . 8)))
(vlax-safearray-fill points '(4 4 0
3 5 0
6 20 0
)
)
(setq plineObj (vla-AddPolyline modelSpace points))
(vla-put-Lineweight plineObj acLnWt211)
(vla-SetRGB MyColorObjOne 90 110 150)
(vla-put-TrueColor plineObj MyColorObjOne)
;; Draw a line
(setq startPoint (vlax-3d-point 5 13 0)
endPoint (vlax-3d-point 5 27 0))
(setq lineObj (vla-AddLine modelSpace startPoint endPoint))
(vla-put-Lineweight lineObj acLnWt211)
(vla-SetRGB MyColorObjOne 50 80 230)
(vla-put-TrueColor lineObj MyColorObjOne)
;; Draw a circle
(setq centerPoint (vlax-3d-point 10 15 0)
radius 5)
(setq circleObj (vla-AddCircle modelSpace centerPoint radius))
(vla-put-Lineweight circleObj acLnWt211)
(vla-SetRGB MyColorObjOne 60 200 220)
(vla-put-TrueColor circleObj MyColorObjOne)
(vla-ZoomAll acadObj)
(vla-Update acadObj)
;; Get an extension dictionary and, if necessary, add a SortentsTable object
(setq eDictionary (vla-GetExtensionDictionary modelSpace))
;; Prevent failed GetObject calls from throwing an exception
(setq sentityObj (vl-catch-all-apply 'vla-GetObject (list eDictionary "ACAD_SORTENTS")))
(if (= (type sentityObj)'VL-CATCH-ALL-APPLY-ERROR)
;; No SortentsTable object, so add one
(setq sentityObj (vla-AddObject eDictionary "ACAD_SORTENTS" "AcDbSortentsTable"))
)
(setq ObjIds (vlax-make-safearray vlax-vbLong '(0 . 2)))
(vlax-safearray-put-element ObjIds 0 (vla-get-ObjectID plineObj))
(vlax-safearray-put-element ObjIds 1 (vla-get-ObjectID lineObj))
(vlax-safearray-put-element ObjIds 2 (vla-get-ObjectID circleObj))
(setq varObject circleObj)
(setq arr (vlax-make-safearray vlax-vbObject '(0 . 0)))
(vlax-safearray-put-element arr 0 varObject)
;; Move the circle object to the bottom
(vla-MoveToBottom sentityObj arr)
(vla-Update acadObj)
(vlax-release-object MyColorObjOne)
)