---

Hallo Zusammen,

in meinem Programm sollen im Umkreis von 100 Einheiten alle Texte gelöscht werden. Den Mittelpunkt gibt der User durch einen Klick an.

Gelöst habe ich das bisher mit einem Auswahlsatz, der alle Texte im "Umkreis" von 100 Einheiten beinhaltet:

sSetObj.SelectByPolygon acSelectionSetCrossingPolygon, dblKoord, groupCode, dataCode

in dblKoord stehen die Eckkoordinaten des Polygons um den Mittelpunkt
in groupCode und dataCode die DXF Eigenschaften vom Text.

PROBLEM: Wenn das Umringpolygon nicht innerhalb des aktuellen Zoomauschnitts liegt, werden auch nicht alle Texte gefunden.
Das kenne ich vom "normalen" Arbeiten mit ACAD: Wenn man während des aufziehens eines Auswahlfensters den Zoom verändert, fallen ggf. auch ausgewählte Elemente wieder aus dem Auswahlsatz.

Gibt es hierfür in VBA eine LÖSUNG ? Ich könnte natürlich hergehen und den Zoom in jedem Falle vergrößern (notfalls zoom extent). Lieber wäre mir aber eine Lösung, wo der USER "nichts bemerkt".

Danke im voraus und viele Grüsse

Martin

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

---

Hallo Martin,

bilde doch einen Auswahlsatz über alles (?SelectionSetAll?) und
gib einen Filter mit. Im Filter sind dann die DXF Gruppencodes für
Rechts- und Hochwert.

Stelli

------------------
Warum lisp'eln wenn's auch anders geht.

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

---

Hallo Stelli,

vielen Dank für deine Antwort. Interessanter Ansatz: Habe einiges probiert und nachgelesen - ohne Erfolg.
Hast du das schonmal erfolgreich angewendet?

Viele Grüsse

Martin

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

---

Hallo Martin,

ich bekomm es auch nicht "wirklich" hin.
Hatte es mal so probiert:

Code:

---

Public Sub del_radius()
    Dim AWSatz As AcadSelectionSet
    Dim entity As AcadEntity
    Dim MPunkt As Variant
    Dim LU_Punkt(0 To 2) As Double
    Dim RO_Punkt(0 To 2) As Double
    Dim InsPunkt As Variant
    Dim Radius As Double
   
    On Error Resume Next
    Set AWSatz = ThisDrawing.SelectionSets("Myselset")
    If Err.Number <> 0 Then
      Set AWSatz = ThisDrawing.SelectionSets.Add("Myselset")
    End If
    On Error GoTo 0
   
    ' Mittelpunkt
    On Error Resume Next
    MPunkt = ThisDrawing.Utility.GetPoint(, Chr$(10) & "Mittelpunkt klicken:")
    If Err.Number <> 0 Then
      End
    End If
    On Error GoTo 0
   
    Radius = 100
    LU_Punkt(0) = MPunkt(0) - Radius
    LU_Punkt(1) = MPunkt(1) - Radius
    RO_Punkt(0) = MPunkt(0) + Radius
    RO_Punkt(1) = MPunkt(1) + Radius

    ' alle Blockrefs wählen
    Dim FType%(0), FData(0)
    FType(0) = 0: FData(0) = "INSERT"
   
    AWSatz.Clear
    AWSatz.Select acSelectionSetCrossing, LU_Punkt, RO_Punkt, FType, FData
       
    For Each entity In AWSatz
        InsPunkt = entity.InsertionPoint
        If Sqr((InsPunkt(0) - MPunkt(0)) ^ 2 + (InsPunkt(1) - MPunkt(1)) ^ 2) <= Radius Then
          entity.color = acRed
          entity.Update
        End If
    Next entity
End Sub

---

Hat aber den gleichen Fehler das Elemente ausserhalb des Bildschirmfensters nicht gewählt werden.

Eine AND / OR Verknüpfung der Filterdaten krieg ich schon noch hin, aber die Formulierung von < oder > als Koordinate nicht mehr.

Stelli

------------------
Warum lisp'eln wenn's auch anders geht.

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

---

Hallo Stelli,

vielen Dank für deine Mühe.
Als Workaround werde ich nun vor dem Füllen des Auswahlsatzes ein ZoomCenter mit festem Zoomfaktor einbauen, damit gewährleistet ist, dass der "richtige" Bildausschnitt am Schirm ist.
Ich werde aber auch noch mal weiterprobieren. Aus meiner Sicht kann aber nur dein Ansatz mit selectAll zum erfolg führen, weil alle anderen Auswahlmodi von Haus aus nur den Bildschirmausschnitt "verwenden".

Viele Grüsse

Martin

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