---

Hallo liebe VBA-Gemeinde,

Folgendes Problem:

Zur Auswahl von graphischen Elementen für deren Weiterverarbeitung verwende ich üblicherweise ein Selectionset. beispielsweise mit

Dim PolSet As AcadSelectionSet
Dim fCode() As Integer
Dim fWert As Variant

Set PolSet = ThisDrawing.SelectionSets.Add("polset08")
ReDim fCode(3): ReDim fWert(3)
fCode(0) = -4: fWert(0) = "<or"
fCode(1) = 0: fWert(1) = "lwpolyline"
fCode(2) = 0: fWert(2) = "polyline"
fCode(3) = -4: fWert(3) = "or>"
PolSet.SelectOnScreen fCode, fWert

Soweit okay. Bricht man nun aber das Programm mit ESC ab, kommt beim nächsten Aufruf der Fehler, daß es schon vorhanden ist.

Wie kann dieser Fehler abgefangen werden?

Vielen Dank im Voraus - Peter

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

---

Hallo Peter,
du solltest das SS am Ende löschen, dann sollte es keine Fehlermeldung mehr geben.

Code:

---

Dim PolSet As AcadSelectionSet
Dim fCode() As Integer
Dim fWert As Variant

Set PolSet = ThisDrawing.SelectionSets.Add("polset08")
ReDim fCode(3): ReDim fWert(3)
fCode(0) = -4: fWert(0) = "<or"
fCode(1) = 0: fWert(1) = "lwpolyline"
fCode(2) = 0: fWert(2) = "polyline"
fCode(3) = -4: fWert(3) = "or>"
PolSet.SelectOnScreen fCode, fWert

PolSet.delete

---

Noch besser wäre eine kleine Funktion mit Fehlerabfrage. Anbei zwei Varianten. Da man On Error Resume Next so wenig wie möglich einsetzen soll, würde ich die erste Variante bevorzugen.
1.

Code:

---

Public Function CreateSelectionSet(Optional ssName As String = "SS") As AcadSelectionSet

    Dim objSelSet As AcadSelectionSet
    Dim objSelCol As AcadSelectionSets
   
    Set objSelCol = ThisDrawing.SelectionSets
    For Each objSelSet In objSelCol
      If objSelSet.Name = ssName Then
        objSelCol.Item(ssName).Delete
        Exit For
      End If
    Next
    Set objSelSet = objSelCol.Add(ssName)
    Set CreateSelectionSet = objSelSet

End Function

---

2.

Code:

---

Public Function CreateSelectionSet(Optional ssName As String = "SS") As AcadSelectionSet
   
    Dim SS As AcadSelectionSet
   
    On Error Resume Next
    Set SS = ThisDrawing.SelectionSets(ssName)
    If Err Then Set SS = ThisDrawing.SelectionSets.Add(ssName)
    SS.Clear
    Set CreateSelectionSet = SS

End Function

---

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

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

---

Hallo Roland,

danke, die erste Variante gefällt mir gut, werde sie nachher gleich ausprobieren, Dir vorher aber gleich erst mal ein paar Punkte verpassen.

Viele Grüße - Peter

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

---

Wenn es mir gestattet ist, hier noch eine Ergänzung bzw. einen Vorschlag zum Auswahlsatz. Man könnte es auch folgendermaßen gestalten:

Public Function GetSelectionSet(Name As String = "SS", Optional AcDocument) As AcadSelectionSet
If IsMissing(AcDocument) = True Then
Set AcDocument = ThisDrawing
End If
If TypeName(AcDocument.SelectionSets(Name) = "Nothing" Then
AcDocument.SelectionSets.Add Name
End If
Set GetSelectionSet = AcDocument.SelectionSets(ssName)
Set AcDocument = Nothing
End Function

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

---

Hallo Karsten,
deine Variante schaut zwar nicht schlecht aus, funktioniert aber leider nicht. Zumindest bei mir. Der TypeName des SS ist leider nicht "Nothing".
Hast du es bei dir in Verwendung?

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

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

---

Da die Abfrage TypeName bei nicht vorhandenem SelectionSet einen Fehler auslöst, und nicht wie gewöhnlich Nothing zurückgibt, mußt Du die Funktion um die Zeile On Error Resume Next oder On Local Error Resume Next erweitern, dann sollte es funktionieren.

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

---

Dann hast du ja fast die 2. Variante, oder?
Du übergibst halt noch die Zeichnung.

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

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