---

Hallo,

mit folgendem Programm möchte ich den Flächeninhalt einer Kontur durch gezielte Auswahl der Elemente ermitteln.
Dabei sollen Klicks ins Leere abgefangen werden.
Zuerst wird die äußere Kontur gewäht und danach die gefragt ob noch eine Fläche abgezogen werden soll. Bis dahin funktioniert alles. Sollen jedoch weitere Flächen abgezogen werden, wird die Schleife beim Klick ins Leere beendet da "Minusobjekt" schon einen Wert hat.
Hier der Code:

Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer

Sub Fläche()
Dim Plusobjekt As AcadEntity
Dim Minusobjekt As AcadEntity
Dim Pickpunkt As Variant
Dim Fläche As Double
Dim MinusFläche As Double
Dim Antwort As String
Dim Wert As New DataObject
Dim iKeyCode
Wert.Clear
Err.Clear
Antwort = "N"
Fläche = 0
Wert.SetText Fläche
Wert.PutInClipboard
Do Until Fläche > 0
    On Error Resume Next
    ThisDrawing.Utility.GetEntity Plusobjekt, Pickpunkt, "Kontur auswählen: "
    iKeyCode = GetAsyncKeyState(&H1B)
    If Err.Number <> 0 Then
        Err.Clear
        If (iKeyCode And &H1B) = 1 Then
            Exit Sub
        End If
    End If
    Fläche = Plusobjekt.Area
Loop
Plusobjekt.Highlight True
Plusobjekt.Update

ThisDrawing.Utility.InitializeUserInput 0, "J N"
Antwort = ThisDrawing.Utility.GetKeyword("sollen noch Flächen abgezogen werden [Rechtsklick für NEIN]/J ? ")
   
If Antwort = "J" Then
    Do Until Antwort = ""
        MinusFläche = 0
        Do Until MinusFläche > 0
            MinusFläche = 0
            On Error Resume Next
            ThisDrawing.Utility.GetEntity Minusobjekt, Pickpunkt, "abzuziehende Kontur auswählen: "
            iKeyCode = GetAsyncKeyState(&H1B)
            If Err.Number <> 0 Then
                Err.Clear
                If (iKeyCode And &H1B) = 1 Then
                    MinusFläche = 0
                    Exit Sub
                End If
            End If
            MinusFläche = Minusobjekt.Area
        Loop
        Fläche = Fläche - MinusFläche
        Antwort = ""
        ThisDrawing.Utility.InitializeUserInput 0, "J N"
        Antwort = ThisDrawing.Utility.GetKeyword("sollen noch weitere Flächen abgezogen werden [Rechtsklick für NEIN]/J ? ")
    Loop
End If
Fläche = Round(Fläche, 0)
Wert.SetText Fläche
Wert.PutInClipboard
Plusobjekt.Highlight False
Plusobjekt.Update
End Sub

Was müsste ich ändern ?
Das Sichtbarmachen was gewählt wurde (highlight) funktioniert leider auch noch nicht.

Mit freundlichen Grüßen

Paul

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

---

Hallo Paul,

wenn du eine andere Abbruchbedingung nimmst sollte es gehen.
Mal ungetestet:

Code:

---

....
ThisDrawing.Utility.InitializeUserInput 0, "J N"
Antwort = ThisDrawing.Utility.GetKeyword("sollen noch Flächen abgezogen werden [Rechtsklick für NEIN]/J ? ")

If Antwort = "J" Then
   vlbo_Abziehen = true
end if

While vlbo_Abziehen = true   
    MinusFläche = 0
    On Error Resume Next
    ThisDrawing.Utility.GetEntity Minusobjekt, Pickpunkt, "abzuziehende Kontur auswählen: "
    iKeyCode = GetAsyncKeyState(&H1B)
    If Err.Number <> 0 Then
        Err.Clear
        If (iKeyCode And &H1B) = 1 Then
            vlbo_Abziehen = false
            MinusFläche = 0
            Goto ExitAndRestore
        End If
    End If
     ' Hier müsste noch eine Typ Prüfung rein da man ja auch einen Text gewählt haben könnte
    MinusFläche = Minusobjekt.Area
    Fläche = Fläche - MinusFläche
    Antwort = ""
     ThisDrawing.Utility.InitializeUserInput 0, "J N"
     Antwort = ThisDrawing.Utility.GetKeyword("sollen noch weitere Flächen abgezogen werden [Rechtsklick für NEIN]/J ? ")
     if Antwort = "J" then
        vlbo_Abziehen= true
     else
        vlbo_Abziehen= false
     end if
wend

:ExitAndRestore

Fläche = Round(Fläche, 0)
Wert.SetText Fläche
Wert.PutInClipboard
Plusobjekt.Highlight False
Plusobjekt.Update
End Sub

---

 

Zitat:

---

Was müsste ich ändern ?
Das Sichtbarmachen was gewählt wurde (highlight) funktioniert leider auch noch nicht.

---

IMHO müsste es reichen das UPDATE nach dem HIGHLIGHT weg zu lassen.
Plan B wäre die Originalfarbe des Entitys zwischenzuspeichern und das Entity temporär auf rot zu setzten.

Wilfried Stelberg

------------------
Warum lisp'eln wenn's auch anders geht. 
www.ib-stelberg.de

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

---

Vielen Dank für die schnelle Antwort,

ein Klick ins Leere führt jedoch gleich zur Frage ob weitere Flächen hinzugefügt werden sollen.

Mit freundlichen Grüßen
Paul

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