---

Liebes Forum,

wie kann man in AutoCAD ein laufendes VBA Makro, das auf eine Usereingabe wartet,
über einen Icon in der Werkzeugleiste beenden und ein neues Makro starten?

Die Usereingabe ("Block auswählen) ist so programmiert, dass Fehler, wie z.B. "Drücken der Taste ESC" in der Eingabe abgefangen werden.

Das Problem ist, wenn bei laufendem Makro ein neues Makro über einen Icon in der Werkzeugleiste (^c^c-vbarun NeuesMakro gestartet werden soll, reagiert die Fehlerabfangroutine und das laufende Programm wird nicht beendet, sondern läuft weiter.

Wie kann man das lösen?

------------------
Grüße aus München
Christian

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Drücken der ESC-Taste ist kein Fehler, sondern ein Befehl an das Programm den aktuellen Vorgang abzubrechen.

Wer auch immer also  "Drücken der Taste ESC" in der Eingabe abgefangen werden" programmiert hat,
hat einen Fehler gemacht (es wurde gegen die gängige Syntax des Programm programmiert).

Korrigiert den Fehler und die Frage wäre nicht aufgetaucht.

Da dies auf der Hand liegt, du aber nicht angesprochen hast: Warum?

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo, das geht so nicht, wenn Du im laufenden Makro über die Fehlerbehandlung ESC abfängst und nicht ordnungsgemäß beenden kannst.
Du könntest über die USERI...-Systemvariablen einen Flag setzen, der dem laufenden Makro das Signal gibt: Hey, bei ESC brich nicht ab, außer es ist der Flag gesetzt. Das bedeutet aber, Du musst auch den anderen Code anpassen.
VG, Fred

------------------
Fred Tomke
Dipl.-Ing. (FH) Landespflege

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo zusammen,

ich habe das so programmiert.
Weil ich nicht weiß, wie man auf das Ereignis drücken der Taste ESC, wenn eine Usereingabe gefordert ist, abfangen soll.

Der User soll einen Block anklicken.
Er hat die Möglichkeit an dieser Stelle Verschiedene Eingaben zu tätigen.
Strg+LM, Shift+LM, nur RM und eben auch auf ESC.
Bei Esc wird die Eingabe in der Zeichnung beendet und das Programm springt zu eine Eingabeformular zurück.

Wenn ich Eure Antworten richtig verstehe, sollte ich auf die Tastatureingabe ESC gar nicht reagieren. Richtig?
Unten mal der gekürzte Code.

Code:

---

....
    On Error Resume Next
    ThisDrawing.Utility.GetEntity objH1, basePt1, "EINEN Block auswählen: "
        iKeyCode = GetAsyncKeyState(&H1B)  ' abfragen, ob ESC noch gedrückt ist
        iMouseCode = GetAsyncKeyState(&H2)  ' abfragen, ob rechte MouseTaste gedrückt ist
        iStrgCode = GetAsyncKeyState(&H11)  ' abfragen, ob Strg gedrückt gehalten wird
...
    If Err <> 0 Then
        MsgBox Err.Number & vbCrLf & Err.Description
        Err.Clear
        If CBool(iShiftCode And &H8000) And CBool(iKeyCode And &H1B) Then
            'MsgBox "Shift+[ESC]"
...
           
        ElseIf CBool(iKeyCode And &H1B) Then  'Abbruch mit Taste "Esc"
            'MsgBox "[ESC]"
            'Programm beenden
            GoTo Exit_Sub
               
        ElseIf CBool(iMouseCode And &H1) Then  'rechte Moustaste wurde gedrückt
            'MsgBox "RM"
...
            GoTo Exit_Sub
           
           
        Else 'Bei Blockeingabe ins Leere geklickt
           
            If CBool(iStrgCode And &H8000) Then
                'MsgBox "[Strg] + LM, Ins Leere geklickt"
                ...

            ElseIf CBool(iShiftCode And &H8000) Then
                'MsgBox "[Shift] + LM, Ins Leere geklickt"
...
               
            Else
                'MsgBox "LM, Ins Leere geklickt"
...
               
            End If
           
        End If
    Else
…
    Endif

---

Wenn das Makro auf die Eingabe eines Blocks wartet und ich ein neues Makro über die Werkzeugleiste starte entsteht ein Fehler.

Deshalb die Frage: Wie breche ich eine Usereingabe durch anklicken eines Icons in der Werkzeugleiste ab?

------------------
Grüße aus München
Christian

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi,

ganz klar komme ich mit deiner Antwort nicht, aber ich antworte dennoch
und hoffe hier meldet sich für dich bald mal ein VBA Geschulter, HALLO?!?

>"Weil ich nicht weiß, wie man auf das Ereignis drücken der Taste ESC, wenn eine Usereingabe gefordert ist, abfangen soll"
Dein Code sieht mir aber ganz so aus als würdest du das bereits machen!?
Abfangen bedeutet doch das man die Aktion unterbindet, oder verarbeitet (statt den natürlichen Lauf der Dinge zu gewähren)

>"Strg+LM, Shift+LM, nur RM und eben auch auf ESC."
>"Bei Esc wird die Eingabe in der Zeichnung beendet und das Programm springt zu eine Eingabeformular zurück"

Okay, ich hoffe ich kann jetzt für dich die Situation 'für alle' klar darlegen, aber womöglich hast du noch nicht alle Infos gegeben:

Level 0, kein Befehl aktiv
Level 1, man startete einen Befehl (hier ist noch nicht klar ob man direkt in dem Eingabeformular ist, oder ob das Eingabeformular eine Folge irgendeiner Aktion ist)
Level 2, im Eingabeformular wurde irgendwas gewählt und man wird zur Objektwahl aufgerufen
<<Dann klickt der USer auf eine ACAD Standard-Schaltfläche wie zB. "Kopieren">>

Soweit richtig?
Das Eingabeformular sollte man, wenn es das nicht ohnehin ist, dem oldschool Windows-Dialogfenster gleichsetzen können, richtig?
In dem Fall wird das in AutoCAD selbst auch nicht sauber gehandhabt:
Ein [ESC] würde die Objektwahl abbrechen, jedoch nicht den Befehl
man landet wird im Windows-Dialogfenster
wird dieses dann geschlossen, verarbeitet Acad das zweite [ESC] aus dem Menümakro
und bricht damit den laufenden Befehl ab, oder wenn kein Befehl läuft - dann ist es halt ein sinnloses[ESC] ohne jegliche Wirkung.
Danach wird der Befehl, wie zB. Kopieren, gestartet.

Menümakro können nicht auf Dialogfenster wirken.
Wenn du dein Tool anders arbeiten lassen möchtest, also nicht entsprechend dme acad Standard, dann
liegt das in deiner Hand.
Wenn bei der Objektwahl ESC gedrückt wird, dann setze ein Flag "ESC=Ja" und zurück im Eingabeformular ist deinem
dir/deinem Programm dann bekannt das es schließen muss.

>"Wenn ich Eure Antworten richtig verstehe, sollte ich auf die Tastatureingabe ESC gar nicht reagieren. Richtig?"
ESC bricht den aktuellen Level ab, du mußt also reagieren - aber das machst du ja auch schon!

Beispiel

>"entsteht ein Fehler"
Zweit schlechteste und am häufigsten verwendete Formulierung im Supportdienst 
Acad-Fehler? VBA-Fehler? Fehlermeldung? -> da ich mich aber aktuell nicht näher mit VBA beschäftige, wäre das nur für andere Interessant

>"Deshalb die Frage: Wie breche ich eine Usereingabe durch anklicken eines Icons in der Werkzeugleiste ab?"
Du brichst doch schon ab und landest im Eingabeformular (was hoffentlich ein oldschool Windowsdialog Fenster ist, nur dann stimmt es was ich schreibe)

Das Problem in AutoCAD ist: Ein AutoCAD-Menümakro wirkt nicht auf ein Windowsdialog Fenster, niemals.
Daher wird deine Benutzereingabe abgebrochen, du landest im  Windowsdialog Fenster,
schließt du dieses
folgt das zweite ESC aus dem Menümakro *Abbruch* und das restliche Makro sollte durchlaufen.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi cadffm,

danke für die Denkanstöße.

Ich habe meinen Code mal verschlankt und hänge an folgender Stelle.
Der User wird zur Eingabe eines Blocks aufgefordert.
Statt eines Objekts klickt der User:
A) ins Leere
B) auf den Icon einer Werkzeugleiste mit dem Befehlen "^c^cNeuesMakro"
C) auf ESC

Ist die Fehlerabfangroutine mit "On Error Goto 0" ausgeschaltet dann entsteht der Fehler -2147352567 und das Programm hält an "Debuggen oder beenden".

Setze ich "On Error Resume Next" vor die Objektwahl, läuft das Programm  weiter und geht in die If-Abfragen. Es läuft aber in allen drei Fällen einfach durch.

Mein Problem ist, dass die Aktion "mit LM ins Leere geklickt" sich nicht von der Eingabe ESC unterscheiden lässt, da immer die gleiche Fehlernummer ausgegeben wird.

Wie kann ich die beiden Fälle unterscheiden? 

Hier mal mein Testcode:

Code:

---

Sub Main()
    Dim boL As Boolean
    'Formular laden
    Load UserForm1
A:
    'Formular anzeigen
    UserForm1.show
    'Unterprogramm aufrufen
    Test1 boL
    If boL = True Then GoTo A
    'Formular entladen
    Unload UserForm1

End Sub

Sub Test1(Optional boL As Boolean = False)
    Dim iKeyCode, iMouseCode, iStrgCode, iShiftCode
    Dim objH1 As AcadBlockReference
    Dim basePt1 As Variant
   
A: 'Blockwahl durch Anklicken
    On Error Resume Next
    iKeyCode = 0
    iMouseCode = 0
    iStrgCode = 0
    iShiftCode = 0
   
    'Block anklicken
    ThisDrawing.Utility.GetEntity objH1, basePt1, "EINEN Block auswählen: "
        'Mögliche Eingaben:
        'LM ... Block anklicken (Standard). Nicht fehlerauslösend.
        'Esc ... Escape.                    Fehlerauslösend
        'RM ... Keine Blockreferenz wählen, sondern vorher ausgewählte Blockreferenz erneut verwenden
        'Strg + LM auf Block ... Aktion A  Nicht fehlerauslösend.
        'Strg + LM ins Leere ... Aktion B  Nicht fehlerauslösend.
        'Shift + LM auf Block ... Aktion C  Nicht fehlerauslösend.
        'Shift + LM ins Leere ... Aktion D  Nicht fehlerauslösend.
        'LM ins Leere ... Block nicht getroffen

        iKeyCode = GetAsyncKeyState(&H1B)  ' abfragen, ob ESC gedrückt wurde
        iMouseCode = GetAsyncKeyState(&H2)  ' abfragen, ob RM gedrückt wurde
        iStrgCode = GetAsyncKeyState(&H11)  ' abfragen, ob Strg gedrückt wurde
        iShiftCode = GetAsyncKeyState(&H10)  ' abfragen, ob Shift gedrückt wurde
       
    If CBool(iStrgCode And &H8000) Then
        'Strg wird gedrückt gehalten
        '...
        Stop

    ElseIf CBool(iShiftCode And &H8000) Then
        'Shift wird gedrückt gehalten
        '...
        Stop

  Else
        'Nichts zusätzlich machen.
        '...
        Stop

    End If

    If Err <> 0 Then
        MsgBox Err.Number & vbCrLf & Err.Description, vbInformation, "LÖSCHEN"

        If CBool(iKeyCode And &H1B) Then  'Abbruch mit Taste "Esc"
            'MsgBox "[ESC]"
            'Programm beenden
            boL = False 'Rückgabewert für "Ende des aufrufenden Makros" setzen
            Stop
            GoTo Exit_Sub
       
        ElseIf CBool(iShiftCode And &H8000) And CBool(iKeyCode And &H1B) Then
            'MsgBox "Shift+[ESC]"
            'Zurück zum Formular (aus aufrufendem Sub)
            boL = True 'Rückgabewert für Loop im aufrufenden Programm setzen
            Stop
            GoTo Exit_Sub

        ElseIf CBool(iMouseCode And &H1) Then  'rechte Moustaste wurde gedrückt
            'MsgBox "RM"
            'Keine Blockreferenz wählen, sondern vorher ausgewählte Blockreferenz erneut verwenden
            'Zurück zum Formular (aus aufrufendem Sub)
            Stop
            boL = True 'Rückgabewert für Loop im aufrufenden Programm setzen
            GoTo Exit_Sub

        Else 'Bei Blockeingabe ins Leere geklickt

            If CBool(iStrgCode And &H8000) Then
                'MsgBox "[Strg] + LM, Ins Leere geklickt"
                'Zurück zum Formular
                Stop
                boL = True
                GoTo Exit_Sub

            ElseIf CBool(iShiftCode And &H8000) Then
                'MsgBox "[Shift] + LM, Ins Leere geklickt"
                'Zurück zum Formular
                Stop
                boL = True
                GoTo Exit_Sub

            ElseIf Err.Number = -2147352567 Then
                'Ausnahmefehler
                'MsgBox "LM, Ins Leere geklickt" oder "Esc"
                Stop
                Err.Clear
                GoTo A

            Else
                'MsgBox "sonstiger Fehler"
                'Erneuter Versuch
                Stop
                Err.Clear
                GoTo A

            End If

        End If

        Err.Clear

    Else 'kein Fehler
        '... Programmteil
        MsgBox "Programm läuft ab"
        Stop
       
    End If

Exit_Sub:
    Exit Sub

Err_Sub:
    GoTo Exit_Sub
   
End Sub

---

Danke nochmal für's Mitdenken.

------------------
Grüße aus München
Christian

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Vielleicht hilft das hier ja.
Eins ist ja klar, wenn das Selektionset leer ist will der user wohl abbrechen oder eine weitere verarbeitung ergibt keinen Sinn.

https://forums.autodesk.com/t5/vba-forum/user-input-with-getentity/td-p/10478160

Sub WorkWithBlock()
    Dim kwordlist As String
    kworkdlist = "Pick Name"
    Dim Response As String
    Dim MySS As AcadSelectionSet
   
    ThisDrawing.Utility.InitializeUserInput 38, kwordlist
    Response = ThisDrawing.Utility.GetKeyword("\nChoose whether to select block by Picking on-screen or entering its Name. [Pick/Name] :  <Pick>")
    Select Case Response
    Case Is = "Pick"
        Set MySS = GetSS_BlockFilter
    Case Is = "Name"
        Set MySS = GetSS_BlockAtt
    End Select
   
    'Do something with MySS
   
End Sub

Public Function GetSS_BlockFilter() As AcadSelectionSet
    'creates an ss of Blocks only
    Dim s1 As AcadSelectionSet      'for pfss
    Dim s2 As AcadSelectionSet      'for filtered ss
   
    Dim intFtyp(0) As Integer                      ' setup for the filter
    Dim varFval(0) As Variant
    Dim varFilter1, varFilter2 As Variant
    intFtyp(0) = 0: varFval(0) = "INSERT"          ' get only blocks
    varFilter1 = intFtyp: varFilter2 = varFval
    Set s2 = AddSelectionSet("ssBlockFilter")              ' create or get the set
    s2.Clear                                        ' clear the set
    s2.SelectOnScreen varFilter1, varFilter2        ' do it

    s2.Highlight True
    s2.Update
    Set GetSS_BlockFilter = s2

End Function

Public Function GetSS_BlockAtt(AttName As String) As AcadSelectionSet
    'creates a ss of blocks with the name supplied in the argument
    Dim s2 As AcadSelectionSet
   
    Set s2 = AddSelectionSet("ssBlocks")                ' create ss with a name
    s2.Clear                                        ' clear the set
    Dim intFtyp(0) As Integer                      ' setup for the filter
    Dim varFval(0) As Variant
    Dim varFilter1, varFilter2 As Variant
    intFtyp(0) = 0: varFval(0) = "INSERT"          ' get only blocks
    varFilter1 = intFtyp: varFilter2 = varFval
    s2.Select acSelectionSetAll, , , varFilter1, varFilter2        ' do it
    Dim oBlk As AcadBlockReference
    Dim oAtt As AcadAttributeReference
    For Each oBlk In s2
        Dim oAtts As Variant
        Dim cnt As Integer
        If oBlk.HasAttributes Then
            Set oAtts = oBlk.GetAttributes
            For i = 0 To UBound(oAtts)
                If oAtts(i).TextString = AttName Then
                    Dim ary(0) As Variant
                    Set ary(0) = oAtts(i)
                    s2.AddItems ary
                End If
            Next i
        End If
    Next oBlk
    Set GetSS_AttName = s2

End Function

Public Function AddSelectionSet(SetName As String) As AcadSelectionSet
' This routine does the error trapping neccessary for when you want to create a
' selectin set. It takes the proposed name and either adds it to the selectionsets
' collection or sets it.
    On Error Resume Next
    Set AddSelectionSet = ThisDrawing.SelectionSets.add(SetName)
    If Err.Number <> 0 Then
        Set AddSelectionSet = ThisDrawing.SelectionSets.Item(SetName)
        AddSelectionSet.Clear
    End If
End Function

------------------
Wer es nicht versucht, hat schon verlorn 
Und bei 3 Typos gibts den vierten gratis !
<<< not for sale !

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP