[求助]：用VBA如何实现命令"Draworder"的功能？

cyt4321

斑竹、各位大侠：
    用VBA如何实现命令"Draworder"的功能？盼回答！

aidraft

下面代码可以将刚画好的图元放在底层，相当于draworder L  B
Thisdrawing.SendCommand "_DRAWORDER" _
& vbCr & "L" & vbCr & vbCr & "b" & vbCr

cyt4321

谢谢，但我要对获得的一批实体进行操作，如何进行呢？盼指教！

aidraft

Option Explicit

Sub Send2Back()
Dim objSS As AcadSelectionSet
On Error GoTo Done
    With ThisDrawing.Utility
    Set objSS = ThisDrawing.SelectionSets.Add("sset")
    objSS.SelectOnScreen
    End With
Done:
    If Not objSS Is Nothing Then
    objSS.Delete
    End If
ThisDrawing.SendCommand "_draworder" & vbCr & _
  "(ssget ""p"")" & vbCr & vbCr & "b" & vbCr
End Sub

cyt4321

多谢大侠指点。

雪山飞狐(lzh)

2005里可以这样：
Sub tt()
    '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 ss As AcadSelectionSet
    Set ss = CreateSel
    ss.SelectOnScreen
    sentityObj.MoveToBottom Sel2Arr(ss)
End Sub

Function Sel2Arr(TlsSel As AcadSelectionSet)
    Dim objs() As AcadEntity
    Dim nCount As Integer
    nCount = TlsSel.Count - 1
    ReDim objs(nCount)
    For i = 0 To nCount
        Set objs(i) = TlsSel(i)
    Next i
    Sel2Arr = objs
End Function

Function CreateSel(Optional ByVal Name As String = "TlsSel")
On Error Resume Next
    ThisDrawing.SelectionSets(Name).Delete
    Set CreateSel = ThisDrawing.SelectionSets.Add(Name)
End Function