---

Hallo Spezialisten!

Ich möchte per VBA alle Elemente die an einem Punkt starten, enden oder duch ihn hindurchgehen, einem Selectionset zuordnen.
Nur leider nimmt mit AutoCAD bei folgendem Code nur ein Element!
Weiss jemand Abhilfe, wie ich alle Elemente bekomme, die durch diesen Punkt gehen?

VBA Code bisher:
Public Sub TestSelect()
    Dim Punkt As Variant
    Dim sset As AcadSelectionSet
   
    Punkt = ThisDrawing.Utility.GetPoint(, "Punkt wählen: ")
    Set sset = ThisDrawing.SelectionSets.Add("SS1")
   
    sset.SelectAtPoint (Punkt)
    sset.Highlight True
    Debug.Print "Einträge: " & sset.Count
    sset.Delete
End Sub

DANKE FÜR JEDEN HINWEIS!!!!
Gruss Lars!

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

---

Mehrfacher Aufruf des SelectionSets:
nach jedem Aufruf das zurückgegeben Element
in einem Array speichern, aus dem SelectionSet
entfernen, ausblenden so das nicht sichtbar und
wieder wählen, bis SelectionSet leer.

nach ausblenden event. Update erforderlich

Oder ganz klein um den Punkt kreuzen.

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

[Diese Nachricht wurde von Bernd Cuder am 14. Januar 2003 editiert.]

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

---

AuswahlsätzeinVBA.zip

Hallo Lars!

habe in meiner Wühlkiste etwas gefunden! Damit müßtest Du Dein Problem lösen können. Ich habe das Dokument irgenwo gefunden.

Grüße aus Linz

Willi Klemens

PS: Dafür müßten schon 10 Eier rüber!!

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

---

Hallo Willi!

Leider lässt sich die ZIP Datei nicht downloaden!
Bitte nochmal uploaden!

Danke
Lars

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

---

Hallo Willi,
keine Umlaute im Anhang!!!
Keine Unities nötig 

Aus dem nun endlich wieder fast schneelosen Wien

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

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

---

Hallo Lars und Roland!

Sorry, neues Zip-File mit dem VBA-Zeug kommt am Abend!

lg Willi

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

---

Willi, kein Problem, ich wollte auch nur erklären warum es nicht funktioniert, ich hab schon zu lange keinen konstruktiven Beitrag abgegeben.

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

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

---

Auswahlsaetze.zip

So nun funktioniert der Upload!

Und nun sind die 10 Eier gerechtfertigt!

Grüße aus Linz

Willi Klemens

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

---

Scharf am Thema vorbei, von

SelectAtPoint gibts nix im Document

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

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

---

SelectAtPoint.zip

Hallo Lars!

So, damit Bern auch zufrieden ist hab ich Dir noch ein Beispiel mit SelectAtPoint mitgeschickt. Wenns jetzt nicht paßt, dann hoffe ich auch auf bessere Vorschläge.

Grüße aus Linz

Willi Klemens

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

---

Sorry wklemens,

(ich heiße übrigens Bernd nicht Bern)

das bringt uns auch nicht weiter da im Bsp. auch
nur SelectAtPoint einmalig aufgerufen wird
und das ja nur ein Element zurückgibt.

Und genau das ist das Problem. Wir brauchen einen
WorkArround und den Anstoß habe ich ja bereits gegeben.
Entweder SelectAtPoint bis nichts mehr geht oder
Kreuzen (ganz winzig).

Wer mir bei der ganzen Diskussion fehlt
ist RoSiNiNo, der war auf Urlaub, aber
jetzt nicht mehr oder? :-)

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

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

---

Guten Morgen!

Durch den Tip von Bernd bin ich auf folgende Lösung gekommen!

Public Sub TestSelect()
    Dim Punkt As Variant
    Dim Wahl As AcadSelectionSet
    Dim Elemente As AcadSelectionSet
    Dim WahlObjs() As AcadEntity
    Dim i As Integer
   
    Punkt = ThisDrawing.Utility.GetPoint(, "Punkt wählen: ")
    Set Elemente = ThisDrawing.SelectionSets.Add("Elemente")
   
    Set Wahl = ThisDrawing.SelectionSets.Add("Wahl")
    Do
        Wahl.Clear
        Wahl.SelectAtPoint Punkt
       
        If Wahl.Count > 0 Then
            ReDim WahlObjs(0 To Wahl.Count - 1)
            For i = 0 To Wahl.Count - 1
                Set WahlObjs(i) = Wahl.Item(i)
                Wahl.Item(i).Visible = False
                Wahl.Update
            Next i
            Elemente.AddItems WahlObjs
        End If
    Loop Until Wahl.Count = 0
    Wahl.Delete
   
    For i = 0 To Elemente.Count - 1
        Elemente.Item(i).Visible = True
    Next i
    Elemente.Highlight True
    Elemente.Update
    Debug.Print "Einträge: " & Elemente.Count
    Elemente.Delete

End Sub

Funktioniert vorzüglich!
Darf aber trotzdem diskutiert werden!

Gruss Lars

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

---

Hallo Bernd,
natürlich bin ich schon wieder zurück, da dein Lösungsvorschlag so gut war, hab ich einfach nichts mehr hinzuzufügen gehabt.
Wie man sieht, hat es auch so funktioniert.

Ich bin übrigens nächste Woche beim Skifahren   

In Kärnten gibt es ja noch genug Schnee.

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

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