永无止境的命令
我一直在通过观看 BeginCommand、ObjectAdd 和 EndCommand 事件来捕捉到将某些项目添加到绘图中的过程。在触发 EndCommand 事件时，我将处理感兴趣的项目。现在，在 2007 年，默认情况下，“复制”命令设置为“多个”。
因此，如果用户启动 copy 命令，则会触发 begin 命令事件。
当他们单击目标时，将为每个添加的对象触发对象添加事件。
如果他们点击鼠标右键或输入键，则将触发endcommand事件，一切都很好。
但是，如果他们在丢弃项目一次或多次后按 Escape 键，则 endcommand 事件永远不会触发。
在我看来，每个开始的命令都应该结束。即使通过取消命令结束。
有没有人找到解决这个新问题的方法？
**** Hidden Message ***** 尝试一下并适应它。它消除了所有的错误陷阱。
基本原则是:在命令开始时设置一个布尔值，然后在命令结束时将其设置为false。如果begincommand的布尔值为真，则endcommand不会被触发。
Option Explicit
Private PrevLayer As AcadLayer
Private CmdActive As Boolean
Function EscPrompt() As Boolean
Dim varCancel As Variant
varCancel = ThisDrawing.GetVariable("LASTPROMPT")
If InStr(1, varCancel, "*Cancel*")0 Or _
InStr(1, varCancel, "")0 Then 'this takes care of vbarun, toolbarsetc w/ ^C^C
If CmdActive > 0 Then
EscPrompt = True
End If
End If
End Function
Public Property Get oPrevLayer() As AcadLayer
If IsObject(PrevLayer) Then
If PrevLayer Is Nothing Then
Set oPrevLayer = ThisDrawing.Layers("0")
Set PrevLayer = ThisDrawing.ActiveLayer
End If
End If
Set oPrevLayer = PrevLayer
End Property
Public Property Let oPrevLayer(l As AcadLayer)
Set PrevLayer = l
End Property
Public Sub AcadDocument_BeginCommand(ByVal CommandName As String)
Dim oLayer As AcadLayer
If CmdActive Then
If EscPrompt Then
ThisDrawing.ActiveLayer = oPrevLayer
End If
End If
Select Case UCase(CommandName)
' blnActive = False
Case "BHATCH"
Set oLayer = ThisDrawing.Layers("T-Hatch")
CmdActive = True
ThisDrawing.ActiveLayer = oLayer
End Select
End Sub
Private Sub AcadDocument_EndCommand(ByVal CommandName As String)
If CmdActive Then CmdActive = False
Select Case UCase(CommandName)
Case "BHATCH"
ThisDrawing.ActiveLayer = oPrevLayer
Case Else
Exit Sub
End Select
Set PrevLayer = Nothing
End Sub
启动Hatch命令时，绘制矩形并观察图层特性管理器。后来试着逃跑。修复不是直接的，画另一个矩形并观察它的变化。 马克，如果你没有答案，我发现布尔技术可以很好地处理多个命令。
它需要一个集合集，并且ObjectAdded子中给出的项目被添加到这个集合中。
页:
[1]