---

Hallo VBA-Spezies,
es geht mir heute um eine verünftige Fehlerabfrage bei einer InitializeUserInput.
Hier ein Auszug meines Codes

Code:

---

RETRYSLAENGE:
    keywordList = "Block Liste Zeigen"
    ThisDrawing.Utility.InitializeUserInput 128, keywordList

    On Error Resume Next
    SLaenge = ThisDrawing.Utility.GetDistance(, "Segmentlänge angeben oder [Block, Liste, Zeigen]: ")
    If Err Then
        If StrComp(Err.Description, "Benutzereingabe ist ein Schlüsselwort", 1) = 0 Then
        ' One of the keywords was entered
            Err.Clear
            Select Case Format(ThisDrawing.Utility.GetInput, ">")
                Case "BLOCK"
RETRYBLNAME:
                    BlName = Format(ThisDrawing.Utility.GetString(1, "Name des einzufügenden Blocks eingeben: "), ">")
                                   
                Case "LISTE"
                    BlName = BlockAusListe
               
                Case "ZEIGEN"
                    Dim BlNameTemp As AcadBlockReference
                    Dim PtTemp As Variant
                   
                    GetEntityEx BlNameTemp, PtTemp, "Referenzblock zeigen: "
                    On Error GoTo ENDE
                    BlName = BlNameTemp.Name
               
                Case Else
                    ThisDrawing.Utility.Prompt "Erfordert numerischen Abstand, zwei Punkte oder Optionstitel." & vbCrLf
                    GoTo RETRYSLAENGE
                   
            End Select
           
            If BlName = "" Then
                ThisDrawing.Utility.Prompt "Ungültiger Blockname." & vbCrLf
                GoTo ENDE
            End If
                   
            If BlockInDrawing(BlName) = False Then
                ThisDrawing.Utility.Prompt "Kann Block """ & BlName & """ nicht finden." & vbCrLf
                GoTo RETRYBLNAME
            End If
           
            BlockYesNo = True
           
RETRYAUSRICHTEN:
            keywordList = "Ja Nein Yes No"
            ThisDrawing.Utility.InitializeUserInput 128, keywordList
           
            On Error Resume Next
            AusrichtenKeyWord = ThisDrawing.Utility.GetKeyword("Soll der Block mit dem Objekt ausgerichtet werden? [Ja/Nein] <J>: ")
            If Err Then
                Err.Clear
                GoTo ENDE
            Else
                Select Case AusrichtenKeyWord
                    Case "Ja", "Yes", ""
                        Ausrichten = True
                    Case "Nein", "No"
                        Ausrichten = False
                    Case Else
                        ThisDrawing.Utility.Prompt "Ungültiger Optionstitel." & vbCrLf
                        GoTo RETRYAUSRICHTEN
                End Select
            End If
           
            On Error Resume Next
            SLaenge = ThisDrawing.Utility.GetDistance(, "Segmentlänge angeben: ")
            If Err Then
                Err.Clear
                GoTo ENDE
            End If
           
        Else
            If Err.Number = "-2147352567" Then
            ' Der Benutzer hat "ESC" oder "RETURN" gedrückt
            Else
                ThisDrawing.Utility.Prompt "Erfordert numerischen Abstand, zwei Punkte oder Optionstitel." & vbCrLf
                GoTo RETRYSLAENGE
            End If
            Err.Clear
            GoTo ENDE
        End If
    Else
        Err.Clear
        BlockYesNo = False
    End If

---

Ich habe die Fehlerabfrage wie in der Acadhilfe beschrieben, erledigt (If StrComp(Err.Description, "Benutzereingabe ist ein Schlüsselwort", 1) = 0 Then). In meinen Augen ein Schwachsinn, ich habe aber das Problem das ich es nicht anders kann (können schon, ober sicher nicht richtig).
Nun zu meiner Frage, hat schon mal jemand eine Fehlerabfrage "richtig" gemacht? Ich möchte bei der Abfrage erkennen ob ein user z.B. Return oder ESC gedrückt hat.

Geht das nur mit:

Code:

---

Public Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Public Const VK_ESCAPE = &H1B
Public Const VK_LBUTTON = &H1

---

???

------------------
Roland

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

---

Hi,
ich bin zwar nicht der VBA-C r a c k, habe aber mal was geschrieben was hilfreich sein könnte:

Code:

---

' Variablen müssen deklariert werden !
Option Explicit

' Sub "Test" zum Testen von Ausdrücken, Sub's und Functions
' und deren Rückgabewerten
' Testausdrücke folgen...
' Anmerkung: Rückgabewert von Funktionen...
' Wenn Rückgabe ein Objekt ist, dann zuweisen der Rückgabe mit "set [varname] = ..."
' Wenn Rückgabe kein Objekt, dann zuweisen mit "[varname] = ..."
' -> ansonsten Fehlermeldung und Pgm läuft gar nicht erst an!
Sub test()
  Dim back As String 'Rückgabewert der Selektion
  Dim funcUtility As AcadUtility
 
  Set funcUtility = ThisDrawing.Utility   ' Connect to Utility object

  back = EntSelUntil("Wähle Straßenlaterne für Access Daten-Anzeige...", "dblampe", "dbkey")

  Select Case back
    Case ""
      funcUtility.Prompt (vbLf & "Kein gültiges Objekt gewählt!(Objekt verfehlt oder Rechtsklick ausgeführt)")
    Case "Err1"
      funcUtility.Prompt (vbLf & "*Abbruch*, Sie haben den Vorgang abgebrochen!")
    Case "Err2"
      funcUtility.Prompt (vbLf & "Gewählter Block enthält KEINE Attribute!(Falsch definierter Block?)")
    Case "Err3"
      funcUtility.Prompt (vbLf & "Gewählter Block enthält das gesuchte Attribut nicht!")
    Case "Err4"
      funcUtility.Prompt (vbLf & "Der Attributwert des gewählten Blocks ist LEER.")
    Case Else
      funcUtility.Prompt (vbLf & "Der Attributwert des gewählten Blocks ist: " & Chr(34) & back & Chr(34))
  End Select
  funcUtility.Prompt (vbLf & "Befehl: ")
End Sub

' Allgemeines Tool zum wiederholten Wählen eines Acad-Blockes
' der via DB-Key aus Access die dazugehörigen Daten holen kann.
' Ziel: Objekt soll solage gewählt werden, bis der an diese Funktion
' übergebene Blockname "strBlockName" übereinstimmt, oder aber "ESC",
' "Leerklick" oder "Rechtsklick" die Objektwahl beenden.
' Übergabeparameter:
' Anfragetext als str
' Blockname als str
' Attribut 'Tag' als str
' z.B. EntSelUntil("Wähle Straßenlaterne für Access Daten-Anzeige...", "dblampe", "dbkey")
' Rückgabe Access DB-Key oder Fehlerbedingung as String
' Rückgabe "Err1" bedeutet, Abbruch der Funktion mit "Esc"
' Rückgabe von "Err2" bedeutet, Block enthält keine Attribute
' Rückgabe "Err3" bedeutet, daß das gefragte Attribut nicht existiert
' Rückgabe "" bedeutet: Nichts gewählt oder Abbruch
Public Function EntSelUntil(strPrmt As String, strBlockName As String, strAttribName As String) As String
 
  Dim objActObj As Object
  Dim varPoint As Variant
  'Dim strBlockName As String
  Dim intCounter As Integer
  Dim funcUtility As AcadUtility
  Dim intLoopFlag As Integer 'Flag für Schleifenbedingung 0 = Schleife 1 = Schleife verlassen
  Dim strRetValue As String 'Rückgabestring
  Dim strCancel As String
 
  Set funcUtility = ThisDrawing.Utility   ' Connect to Utility object
  strBlockName = UCase$(strBlockName)
 
  On Local Error Resume Next
 
  Do
    funcUtility.GetEntity objActObj, varPoint, vbLf & strPrmt
    If TypeName(objActObj) = "Nothing" Then 'Leerklick, oder Rechtsklick
      strCancel = ThisDrawing.GetVariable("LASTPROMPT") 'Lastprompt auswerten...
      If InStr(1, strCancel, "*Abbruch*") <> 0 Then 'Ist in Lastprompt "*Abbruch*" vorhanden?
        strRetValue = "Err1" 'Gebe diesen Errorcode für Abbruch der Funktion zurück
      End If
      funcUtility.Prompt (vbLf & "Nichts gewählt, Vorgang beendet!") 'Rückmeldung an User
      Exit Do 'Verlasse die Schleife
    Else 'Ansonsten...
      If Not UCase$(objActObj.ObjectName) = "ACDBBLOCKREFERENCE" Then 'Ist's ein Block?
        funcUtility.Prompt vbLf & "Kein Objekt des Typs " & Chr(34) & "BLOCK" & Chr(34) & " gewählt." 'Nein, kein Block
        intLoopFlag = 0
      Else 'Ja ist es...
        If Not UCase$(objActObj.Name) = strBlockName Then 'Stimmt der Blockame?
          funcUtility.Prompt vbLf & "Falscher Block. Gewählt: " & Chr(34) & UCase$(objActObj.Name) & Chr(34) _
                      & " -> Gesucht ist aber: " & Chr(34) & strBlockName & Chr(34)   'BlockName ist falsch
          intLoopFlag = 0
        Else 'Blockname stimmt...
          If Not objActObj.HasAttributes = True Then 'Zur Sicherheit, hat der Block Attribute?
            funcUtility.Prompt (vbLf & "Fehler! Block enthält keine Attribute.") 'Rückmeldung an User
            strRetValue = "Err2" ' Fehler für keine Attribute im Block!
            Exit Do 'Verlasse die Schleife
          Else 'Der Block hat Attribute
            Dim nvarAttrib As Variant
            nvarAttrib = objActObj.GetAttributes 'Packe alle Attribute in ein Variant
            For intCounter = LBound(nvarAttrib) To UBound(nvarAttrib) 'Schleife für Anzahl der Attribute
              If UCase$(nvarAttrib(intCounter).TagString) = UCase$(strAttribName) Then 'Gesuchten TagString aus Attributen filtern
                strRetValue = nvarAttrib(intCounter).TextString 'Gefunden!
                strRetValue = Trim(strRetValue) 'Führende und folgende Leerzeichen entfernen
                If strRetValue = "" Then 'KEIN Inhalt oder ausschließlich Leerzeichen
                  strRetValue = "Err4" '= Attributwert leer!
                End If
                Exit For 'Also raus aus der Schleife
              Else
                strRetValue = "Err3" '= Nicht gefunden
              End If
            Next
            intLoopFlag = 1 'Flag: Loop verlassen! Habe was ich will!
          End If
        End If
      End If
    End If
  Loop Until intLoopFlag = 1 'Wiederholen, bis benannter Block gewählt wurde
  EntSelUntil = strRetValue 'Rückgabewert der Funktion: Wert des Att. oder ""
End Function

---

Ich hoffe das hilft...

------------------
Ciao,
Marc

[Diese Nachricht wurde von marc.scherer am 10. Dezember 2002 editiert.]

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

---

Danke  Marc,
werde ich mir mal genauer ansehen.

------------------
Roland

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

---

Hi RoSiNiNo,

kann dir erst am Abend ein Bsp.
zukommen lassen.

GetAsyncKeyState ist doch
eh ein netter Ansatz, was hast
du dagegen.

Statt err.description nehme
ich err.number.

Hast du meine VB-DLL schon mal
ausprobiert? Werde dir denn
Quellcode als TXT schicken,
rennt auch in VBA.

------------------
Bernd Cuder
Cad&Co makes CAD easy

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

---

Hallo Bernd,
GetAsyncKeyState hab ich noch nie ausprobiert, obwohl ich auch glaube das es der beste Lösungsansatz ist.
Ich hab die dll leider noch nicht ausprobiert, würde mich aber über den Quelltext freuen.
Wenn ich das Tool dann auch mit einer ordentlichen Abfrage fertiggestellt habe, kann ich dir das Ding einmal schicken (hast du AcadX.arx schon angesehen?).

------------------
Roland

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

---

Hallo Roland,

jetzt weiß ichs wieder,
unterscheide Leereingabe und
ESC durch Abfrage von ERRNO,
dann gehts auch ohne API.

Sample kommt gleich, stricke
nur noch eine Beispieleingabe.

------------------
Bernd Cuder
Cad&Co makes CAD easy

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

---

Hi Bernd,
ist das so wie bei GetEntityEx?
Bin schon gespannt.

------------------
Roland

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