[编程交流] 如何将物体放在前面？

 
Public Elem As Object
   For Each Elem In ThisDrawing.ModelSpace
       With Elem
           If StrComp(.EntityName, "AcDbBlockReference", 1) = 0 Then
               If ((Elem.HasAttributes) And (Left(Elem.EffectiveName, 3) = "G_B") Or (Left(Elem.EffectiveName, 3) = "G_E") Or _
                   (Left(Elem.EffectiveName, 3) = "G_I") Or (Left(Elem.EffectiveName, 3) = "G_L")) Then
[color=red]                Elem.MoveToTop (DOESNT WORK?!)[/color]
               End If
           End If
       End With
   Next Elem

Option Explicit
Sub OrderToTop()
' This example creates a SortentsTable object and
' changes the draw order of selected object(s) to top.
Dim oSset As AcadSelectionSet
Dim oEnt
Dim i As Integer
Dim setName As String
setName = "$Order$"
'Make sure selection set does not exist
For i = 0 To ThisDrawing.SelectionSets.Count - 1
If ThisDrawing.SelectionSets.Item(i).Name = setName Then
ThisDrawing.SelectionSets.Item(i).Delete
Exit For
End If
Next i
Set oSset = ThisDrawing.SelectionSets.Add(setName)
oSset.SelectOnScreen
If oSset.Count > 0 Then
ReDim arrObj(0 To oSset.Count - 1) As AcadObject
'Process each object
i = 0
For Each oEnt In oSset
Set arrObj(i) = oEnt
i = i + 1
Next
End If
On Error GoTo Err_Control
'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
'Move selected object(s) to the top
sentityObj.MoveToTop arrObj
Application.Update
Exit Sub
Err_Control:
If Err.Number 0 Then MsgBox Err.Description
End Sub

Sub OrderToTop()
' This example creates a SortentsTable object and
' changes the draw order of selected object(s) to top.
Dim oSset As AcadSelectionSet
Dim oEnt
Dim I As Integer
Dim setName As String
setName = "$Order$"
'Make sure selection set does not exist
For I = 0 To ThisDrawing.SelectionSets.Count - 1
   If ThisDrawing.SelectionSets.Item(I).Name = setName Then
       ThisDrawing.SelectionSets.Item(I).Delete
   Exit For
   End If
Next I
Set oSset = ThisDrawing.SelectionSets.Add(setName)
[color=red] ReDim ssobjs(0 To ThisDrawing.Blocks.Count - 1) As AcadBlock[/color]
[color=red] I = 0[/color]
[color=red] For I = 0 To ThisDrawing.Blocks.Count - 1[/color]
[color=red]     Set ssobjs(I) = ThisDrawing.Blocks.Item(I)[/color]
[color=red] Next[/color]
[color=red] ' Add the array of objects to the selection set[/color]
[color=red] [b]oSset.AddItems ssobjs[/b][/color]
If oSset.Count > 0 Then
ReDim arrObj(0 To oSset.Count - 1) As AcadObject
'Process each object
I = 0
For Each oEnt In oSset
Set arrObj(I) = oEnt
I = I + 1
Next
End If
On Error GoTo Err_Control
'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
'Move selected object(s) to the top
sentityObj.MoveToTop arrObj
Application.Update
Exit Sub
Err_Control:
If Err.Number <> 0 Then MsgBox Err.Description

Sub OrderToTop()
' This example creates a SortentsTable object and
' changes the draw order of inserted block regerence(s) to top.
Dim oEnt As AcadEntity
Dim oLayout As AcadLayout
Dim I As Integer
Dim ssobjs() As AcadEntity
I = 0
For Each oLayout In ThisDrawing.Layouts
For Each oEnt In oLayout.Block
If TypeOf oEnt Is AcadBlockReference Then
ReDim Preserve ssobjs(I) As AcadEntity
Set ssobjs(I) = oEnt
I = I + 1
End If
Next
Next
On Error GoTo Err_Control
'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
'Move selected object(s) to the top
sentityObj.MoveToTop ssobjs 'arrObj
Application.Update
Exit Sub
Err_Control:
If Err.Number <> 0 Then MsgBox Err.Description
End Sub