Author Topic: The never-ending command  (Read 970 times)

0 Members and 1 Guest are viewing this topic.

mohnston

  • Bull Frog
  • Posts: 305
  • CAD Programmer
The never-ending command
« 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?
It's amazing what you can do when you don't know what you can't do.
CAD Programming Solutions

Bryco

  • Water Moccasin
  • Posts: 1850
Re: The never-ending command
« Reply #1 on: November 01, 2006, 08:38:24 PM »
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.
Code: [Select]
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.

Bryco

  • Water Moccasin
  • Posts: 1850
Re: The never-ending command
« Reply #2 on: November 04, 2006, 02:06:30 PM »
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.