通过VBA使用绘制顺序
**** Hidden Message ***** 您使用的是哪个版本的acad？我还在欧特克知识库中找到了这http://usa.autodesk.com/adsk/servlet/ps/item?id=2878365&linkID=2475323&siteID=123112。他们提供的解决方案可能适合您通过VBA工作吗？
2006
Draworder适用于2006年的xref(至少在我们的办公室是这样的！)
我刚刚意识到我把这个贴在了错误的论坛上，这是一个很好的开始，真是糟糕！:丑陋:
克里斯 嗯...有几点。
1.您永远不应该在反应堆/事件中发出“命令”调用。有一件事可能会陷入无休止的循环。
2.在VBA中没有“可靠”的方法来判断命令是否被取消。所以你必须处理“命令结束”事件不会触发的可能性。
3.此外，有人可以进入参考管理器，除了查看列表什么也不做。您的事件会触发，但用户没有附加另一个xref。
我想你可以开始看到这并不像听起来那么容易。
然而，话虽如此，这里有一个非常快速的敲门砖。将其粘贴到“ThisDrawing”模块中并试一试...
Private Sub AcadDocument_EndCommand(ByVal CommandName As String)
Select Case CommandName
Case "XREF", "XATTACH"
' Get the last entity in the current space. The command *might* not have done anything...
Dim pEnt As AcadEntity
Set pEnt = ThisDrawing.CurrentSpace(ThisDrawing.CurrentSpace.Count - 1)
' Bail out if it's NOT an xref...
If Not TypeOf pEnt Is AcadExternalReference Then Exit Sub
'Gxet an extension dictionary and, if necessary, add a SortentsTable object
Dim pXDict As AcadObject
Set pXDict = ThisDrawing.CurrentSpace.GetExtensionDictionary
' Enable in-line error handling...
On Error Resume Next
Dim pSortEntsTbl As AcadSortentsTable
' Try and get a pointer to the existing (if there is one) SortEntsTable...
Set pSortEntsTbl = pXDict.GetObject("ACAD_SORTENTS")
If Err Then Err.Clear
If pSortEntsTbl Is Nothing Then
' No SortentsTable object, so add one
Set pSortEntsTbl = pXDict.AddObject("ACAD_SORTENTS", "AcDbSortentsTable")
End If
' Resume 'normal' error handling...
On Error GoTo 0
Dim entArray(0) As AcadObject
Set entArray(0) = pEnt
' Move the object to the bottom of the draworder...
pSortEntsTbl.MoveToBottom entArray
AcadApplication.Update
End Select
End Sub
Public Property Get CurrentSpace() As AcadBlock
If ThisDrawing.GetVariable("CVPORT") = 1 Then
Set CurrentSpace = PaperSpace
Else
Set CurrentSpace = ModelSpace
End If
End Property
BTW，在AutoCAD VBA帮助中查找AcadSortEntsTable。这是Draworder表。
干杯，
Glenn。
页:
[1]