---

Hallo,

ich möchte in einer DWG prüfen, ob bestimmte Objekte innerhalb eines Polygons liegen oder nicht.

Gibs dazu einfache Funktionen in VBA oder muss dass mühsam über die Koordinaten bestimmt werden.

Gruß Holger

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

---

guck dir mal die Methode SelectByPolygon des Selectionset-Objectes an

------------------
  - Thomas -
"Bei 99% aller Probleme ist die umfassende Beschreibung des Problems bereits mehr als die Hälfte der Lösung desselben."

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

---

Das werde ich tun. Dank dir 

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

---

Hallo Holger,

hab ein Beispiel gefunden

Code:

---

                ' 2D Koordinaten bei LWPOLYline
                ' Punkte ermitteln
                Anzahl_Punkte = (UBound(Koordinaten) + 1) / 2
                If obj_poly.Closed Then
                    ' Wenn es eine geschlossenen Polylinie war dann füge ersten als letzten Punkt hinzu
                    Anzahl_Punkte = Anzahl_Punkte + 1
                    ReDim Preserve Koordinaten(0 To UBound(Koordinaten) + 2)
                    ' Erster Punkt gleich letzter Punkt
                    Koordinaten(UBound(Koordinaten) - 1) = Koordinaten(0)
                    Koordinaten(UBound(Koordinaten)) = Koordinaten(1)
                Else
                    ' Prüfen ob Anfangspunkt = Endpunkt
                    If Koordinaten(0) <> Koordinaten(UBound(Koordinaten) - 1) Or Koordinaten(1) <> Koordinaten(UBound(Koordinaten)) Then
                      'Koordinaten weichen ab
                      msg = "Linie bildet keine Fläche (Anfangspunkt<>Endpunkt); Neue Linie wählen !"
                      display_message ((msg))
                      ' ......
                    End If
                End If ' obj_poly.closed
               
               
                Dim sel_Text As acadselectionset

                On Error Resume Next
                Set sel_Text = obj_ACAD_app.ActiveDocument.SelectionSets.Add("Texte")
                On Error GoTo 0
                Set sel_Text = obj_ACAD_app.ActiveDocument.SelectionSets("Texte")

               
                ReDim filtertype(0 To 3) As Integer
                ReDim filterData(0 To 3) As Variant
                filtertype(0) = -4
                filterData(0) = "<OR"
                filtertype(1) = 0
                filterData(1) = "TEXT"
                filtertype(2) = 0
                filterData(2) = "MTEXT"
                filtertype(3) = -4
                filterData(3) = "OR>"

                group = filtertype
                fdata = filterData
               
                ReDim Umring_koord(0 To (Anzahl_Punkte - 1) * 3 - 1)
                Dim v%
                'Debug.Print UBound(Umring_koord)
                ' den letzen Punkt nicht übertragen
                For v = 0 To Anzahl_Punkte - 2
                    Umring_koord(v * 3) = Koordinaten(v * 2)
                    Umring_koord(v * 3 + 1) = Koordinaten(v * 2 + 1)
                    Umring_koord(v * 3 + 2) = 0
                Next v
                   
                ' acSelectionSetWindowPolygon  = 6
                ' acSelectionSetFence          = 2
                ' acSelectionSetCrossingPolygon= 7
                mode = 6
                sel_Text.Clear
                sel_Text.SelectByPolygon mode, Umring_koord, group, fdata
 

---

Hatte mit VB nach Texten in einem Umring gesucht.
Die Koordinaten für das Umringspolygon werden als 3D Koordinaten übergeben.

Stelli

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

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

---

Hallo Stelli,

Danke für den Code. Ich habe ihn gerade mal ausgeführt. Dabei habe ich folgendes Problem.

Beim Ausführen fon SelectByPolygon erhalte ich folgende Fehlermeldung:
"Ungültiges Argument Pointslist in SelectByPolygon"

Die Pointslist ist gefüllt. Hast eine Ahnung, wo da das Problem liegen könnte.

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

---

evtl. 2 übereinanderliegente Punkte! d.h. 2 mit gleichen Koordinaten .. die mußt du vorher aus der Liste rausschmeißen

------------------
  - Thomas -
"Bei 99% aller Probleme ist die umfassende Beschreibung des Problems bereits mehr als die Hälfte der Lösung desselben."

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

---

Fehler gefunden.

Ich das Array vorher nicht richtig dimensioniert: Dim Umring_koord() As Double

Jetzt geht es.

Gruß und Danke
Holger

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

---

Hallo Holger,

hatte gerade auch geschaut. Sorry den Deklarationsteil hatte ich nicht gepostet. Da sind auch noch Sachen mit obj_acad_app.activedrawing. Da sollte in VBA halt Thisdrawing stehen.

Stelli

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

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