Sub Example_SortentsTable()
    ' Этот пример создает объект SortentsTable и изменяет порядок рисования.

    ' Установленный рисунок, чтобы показать веса линии и создать
    ' объект True Color
    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)
   
    ' Рисуйте ломаную линию
    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

    ' Рисуйте линию
    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
     
    ' Рисуйте круг
    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
      
    'Получите словарь расширения, и, в случае необходимости, добавьте объект SortentsTable
    Dim eDictionary As Object
    Set eDictionary = ThisDrawing.ModelSpace.GetExtensionDictionary
    ' Предотвратите неудавшиеся запросы GetObject от броска исключения
    On Error Resume Next
    Dim sentityObj As Object
    Set sentityObj = eDictionary.GetObject("ACAD_SORTENTS")
    On Error GoTo 0
    If sentityObj Is Nothing Then
         ' Нет объекта SortentsTable, так что добавьте его
         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
    
    sentityObj.MoveToBottom arr
    AcadApplication.Update
         
End Sub