Topic: Display order

[David Hall]

I did a search and couldn't find any thread on this, so here goes.

Has anyone found a way to use display order without using SendCommand?

[David Hall]

I found this, so I can go from here

Code: [Select]

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.17")
    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

[David Hall]

Here is the final result to send Hatchs to Back

Code: [Select]

Option Explicit

Sub HatchBack()
      Dim n As Integer
      Dim gpCode(0) As Integer
      Dim dataValue(0) As Variant
      Dim objSelSet As AcadSelectionSet
      gpCode(0) = 0
      dataValue(0) = "HATCH"

      If ThisDrawing.SelectionSets.Count > 0 Then
            For n = 0 To ThisDrawing.SelectionSets.Count - 1
                  If ThisDrawing.SelectionSets.Item(n).Name = "DISPLAYORDER" Then
                        ThisDrawing.SelectionSets("DISPLAYORDER").Delete
                  End If
            Next n
      End If

      Set objSelSet = ThisDrawing.SelectionSets.Add("DISPLAYORDER")
      objSelSet.Select acSelectionSetAll, , , gpCode, dataValue

      '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(0) As Long
      Dim varObject As AcadObject
      Dim arr(0) As AcadObject
      Dim obj As Object
      For Each obj In objSelSet
            ObjIds(0) = obj.ObjectID
            Set varObject = ThisDrawing.ObjectIdToObject(ObjIds(0))
            Set arr(0) = varObject
            sentityObj.MoveToBottom arr
      Next
      AcadApplication.Update
      ThisDrawing.SelectionSets.Item("DISPLAYORDER").Delete
End Sub


[Jeff_M]

Hi David,
Might I make one two suggestions?

Since the SortEntity object's MoveTo* methods accept an array, build the complete array first and call the method just once instead of at every object.

Code: [Select]

      Dim arr() As AcadObject
      ReDim arr(0 To objSelSet.Count - 1)
      Dim obj As Object
      n = 0
      For Each obj In objSelSet
            Set arr(n) = obj
            n = n + 1
      Next
      sentityObj.MoveToBottom arr
Not that it would make that much difference in execution speed, but with a lot of hatches it may. Plus, as this would add them to the dictionary in one chunk, I do think it makes a difference in actual display computation time.

Oh, and you will notice I removed the ObjectIdtoObject code. You already have the object in the SS, no reason to get the ObjectID and convert that back to the same object.

[David Hall]

good idea.  I have never used this method before today, so I appreciate the input.