TheSwamp
Code Red => VB(A) => Topic started by: mohnston on November 01, 2006, 07:54:05 PM
-
I have been catching the addition of certain items into a drawing by watching the BeginCommand, ObjectAdded and EndCommand events. I handle the items of interest when the EndCommand event is fired.
Now in 2007 the Copy command is set to "multiple" by default.
So if a user starts the copy command the begincommand event is fired.
When they click a destination the objectadded event is fired for each object added.
If they hit the right mouse button or enter key the endcommand event is fired and all is well.
BUT, if they press the escape key after dropping the items one or more times the endcommand event never fires.
Seems to me that every command that begins should end. Even if the end by canceling the command.
Has anyone found a way around this new issue?
-
Try this out and adapt it. It has all the error trapping taking out.
The basics are; set a boolean when the command has started then set it to false when it ends. If the boolean is true at begincommand then the endcommand wasn't fired.
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
Draw rectangles and watch the layer properties manager as you start the Hatch command. Later try escaping. The fix isn't immediate, draw another rectangle and watch it change.
-
Mark, if you don't have your answer, I found the boolean technique to work well with the multiple commands.
It requires a collection set and the items given in the ObjectAdded sub are added to this collection.