---

problemstellung.jpg

Hallo!

Ich habe ein Problem mit meinem Selection Set. Ich habe ein SelectionSet und möchte innerhalb eines Rechtecks alle Blöcke mit einem bestimmten Namen auswählen. Ich übergebe der Funktion alle möglichen Blocknamen und ein Array mit den Koordinaten. Innerhalb der Methode baue ich mir den geeigneten Filter zusammen (funktioniert, hab ich getestet) und zeichne anschließend ein Polygon zur Kontrolle, ob der Bereich in dem ich suche auch der richtige ist (siehe Grafik). Dazu habe ich folgenden Code implementiert:

Private Function getAllBlocksWithinFence(blocknames As Variant, points As Variant) As Collection
On Error GoTo ErrorHandler

  Dim ret As Collection
  Dim blockset As AcadSelectionSet
  Dim block As AcadBlockReference
  Dim mode As Integer
 
  Dim i As Integer, j As Integer
  j = 1
  ReDim FType(0 To (2 + UBound(blocknames) - LBound(blocknames))) As Integer
  ReDim FData(0 To (2 + UBound(blocknames) - LBound(blocknames))) As Variant

  FType(0) = -4
  FData(0) = "<OR"
  For i = LBound(blocknames) To UBound(blocknames)
    FType(j) = 2
    FData(j) = blocknames(i)
    j = j + 1
  Next i
  FType(j) = -4
  FData(j) = "OR>"
   
  ReDim pointsArray(0 To UBound(points)) As Double
  For i = 0 To UBound(points)
    pointsArray(i) = points(i)
  Next i
   
  mode = acSelectionSetFence
  Set ret = New Collection
  Set blockset = CreateSelectionSet("BLOCKSET")
  blockset.SelectByPolygon mode, pointsArray, FType, FData
 
  ThisDrawing.ModelSpace.AddPolyline (pointsArray)
 
  i = 0
  For Each block In blockset
    ret.Add block, "b" & i
    i = i + 1
  Next block
 
 
  Set getAllBlocksWithinFence = ret
  blockset.Delete
  Exit Function

ErrorHandler:
  blockset.Delete
  Debug.Print Error(Err)
  Err.Clear
  Set getAllBlocksWithinFence = ret
  On Error GoTo 0
End Function

Innerhalb des Bereichs (siehe Grafik) sind zwei Blöcke mit demselben Namen und in der Auswahl des SelectionSets ist aber nur einer (der obere) enthalten. Ich verstehe das nicht ganz. Ich habe es auch bereits mit mode:=acSelectionSetWindowPolygon und mode:=acSelectionSetCrossingPolygon  probiert, erhalte aber nicht das, wonach ist suche.

Kann mir bitte jemand helfen,

lg Peter

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

---

Hi Peter,

Du solltest als erstes mal die Zaun-Auswahlfunktion:

Code:

---

  mode = acSelectionSetFence

---

gegen die Kreuzenfenster-Funktion tauschen:

Code:

---

  mode = acSelectionSetCrossingPolygon

---

Dann funktioniert dein Code.
Beim nächsten Mal wäre es nett, wenn due die Benötigten Funktionen (CreateSelectionSet) und eine kleine Sub mit den Paramtern zum Aufrufen deiner Funktion dazupackst. Dann braucht man nicht erst lange schauen, wie es funktionieren soll.

Gruß, Carsten

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

---

Hi Carsten,

ich habe es gerade mit "acSelectionSetCrossingPolygon" probiert, damit habe ich aber keinen der beiden Blöcke in der Auswahl. Mit dem oberen Code-Stück habe ich einen Block in der Auswahl und wenn ich den Filter weglasse habe ich sowohl bei "acSelectionSetCrossingPolygon" als auch bei "acSelectionSetFence" keinen Block mehr in der Auswahl!? Ich dachte ein Filter schränkt die Auswahl nur ein, wie ist das dann möglich, dass ohne Filter weniger Ergebnisse als mit Filter sind?

Wenn ich FType und FData ausgebe, erhalte ich folgende Werte:

-4    <OR
2    -80
2    -100
2    -125
2    -150
2    -175
2    -200
2    -225
2    -250
2    -275
2    -300
2    80-
2    100-
2    125-
2    150-
2    175-
2    200-
2    225-
2    250-
2    275-
2    300-
2    rechts
2    links
-4    OR>

Die gesuchten Blöcke heißen "-150".

Die Function CreateSelectionSet (stammt aus dem Forum):

Public Function CreateSelectionSet(Optional ssName As String = "SS") As AcadSelectionSet
  Dim objSelSet As AcadSelectionSet
  For Each objSelSet In ThisDrawing.SelectionSets
    If objSelSet.Name = ssName Then
      ThisDrawing.SelectionSets.Item(ssName).Delete
      Exit For
    End If
  Next
  Set objSelSet = ThisDrawing.SelectionSets.Add(ssName)
  Set CreateSelectionSet = objSelSet
End Function

Der Aufruf der Function:

....
  Dim flowingsigns As Collection
  Dim count As Integer
  Dim pointsArray As Variant
 
  pointsArray = getDrainDirectionFence(drain.angle, drain.StartPoint, drain.endpoint, FLOWING_DIRECTION_TOLERANCE)

  'directionmarks .... bezeichnungen der Blöcke (werden zuvor aus Datei gelesen - siehe Ausgabe von FData
  'pointsarray ....... Punkte werden von Funktion abhängig vom Winkel des Kanals berechnet
  '                    (siehe Grafik - gelbe z-förmige Polylinie)

  Set flowingsigns = getAllBlocksWithinFence(directionmarks, pointsArray)
....

Bitte um weitere Ideen für die Problemlösung,

Lg Peter

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

---

Hi Peter,

Wenn ich deine Funktion wie folgt aufrufe:

Code:

---

Public Sub abc()
Dim blocknames(0 To 1) As Variant
Dim flowingsigns As Collection
Dim points(0 To 11) As Double
points(0) = 0
points(1) = 0
points(2) = 0
points(3) = 200
points(4) = 0
points(5) = 0
points(6) = 200
points(7) = 200
points(8) = 0
points(9) = 0
points(10) = 200
points(11) = 0
blocknames(0) = "abc"
blocknames(1) = "def"
Set flowingsigns = getAllBlocksWithinFence(blocknames, points)
End Sub

---

Dann bekomme ich bei der Zaun-Variante nur die Elemente mit der Blockbezeichnung in meinen Filter. Bei der Kreuzen-Fenster-Variante bekomme ich die Elemente, die innerhalb des Fensters liegen und die, die das Fenster kreuzen / berühren.
Bei den Selectionsets ist zu beachten, das nur Elemente, die auch auf dem Bildschirm sichtbar sind, mit ausgewählt werden. Könnte es daran liegen?! Dann solltest du vorher ein Zoom auf die benötigte Fläche / Koordinaten machen.

Gruß, Carsten

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

---

Hallo Carsten!

Danke du hast mir gleich doppelt geholfen 

1.) hatte ich nicht gewusst, dass immer nur der aktuelle Bildschirmausschnitt zur Auswahl herangezogen wird und deshalb nur einen Block im Fenster

2.) wusste ich nicht, dass die Reihenfolge der Punkte (points) entscheidend ist. Oben in meiner Grafik ist ein z-förmige Polylinie herausgekommen als ich die Punkte mit ThisDrawing.ModelSpace.AddPolyline (pointsArray) darstellen ließ. Als ich deinen Zoom-Tipp beachtet hatte, ging es noch immer nicht. Ich habe dann die Punkte so vertauscht, dass sie kein Z sondern ein Rechteck ergeben und jetzt geht es sowohl mit acSelectionSetWindowPolygon als auch mit acSelectionSetCrossingPolygon!!!

Wirklich super, danke!

AutoCAD-Hilfe:

"CrossingPolygon
Selects objects within and crossing an area defined by a polygon. Use Point1 to define the coordinates of the polygon. AutoCAD will close the last vector of the polygon. A polygon definition cannot cross itself."

Dass hätte ich erkennen müssen  .

Kannst du mir noch bitte sagen, wie ich den Winkel in dem sich der Block befindet rausbekomme. Ich habe da ja nur das Attribut InsertionPoint und kein Attribut Angle!?

Liebe Grüße Peter

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

---

Der Drehwinkel der Blockeinfügung steht im
.Rotation Property der Blockreferenz

------------------
Mit freundlichem Gruß

Udo Hübner

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

---

Vielen Dank Udo!

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

---

Hallo Forum!

Ich versteh nicht, warum mein Filtersystem nicht funktioniert:

Code:

---

    Dim FType(1)  As Integer
    Dim FData(1) As Variant
    Dim mode As Integer
    FType(0) = 0: FData(0) = "Leader"  ' oder AcDbLeader
    mode = acSelectionSetCrossingPolygon
    Set lineset = CreateSelectionSet("LINESET")
    lineset.SelectByPolygon mode, pointsArray,FType, FData

---

 

In der Hilfe gibt es ein Beispiel, das auch einen Filter mit "0" und "Circle" verwendet, deshalb gehe ich davon aus, dass es mit "AcadLeader" ähnlich funktioniert.
Wenn ich den Filter so wie er da ist verwende, ist nichts in der Auswahl, wenn ich ihn nicht verwende sind verschiedene Objekte darin, auch die AcDbLeader, die ich eigentlich haben will.

Wie müsste der Filter richtig aussehen?

Lg Peter

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

---

Hi Peter,

Liegt denn die Führungslinie komplett in dem Polygon, oder wird sie vom Polygon teilweise geschnitten?!

Poste doch mal den ganzen Code mit den Koordinaten des Polygons und eine Beispielzeichung, vielleicht lässt sich das Problem dann schneller einkreisen.

Gruß, Carsten

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

---

Problemstellung.jpg

Hallo Carsten,
danke für deine schnelle Antwort!

Ausgehend vond ein gekreisten Schächten analysiere ich jedes Kanalstück (rote Linie), berechne ein Reckeck mit dem Abstand 0.3 (Seite a hat die Länge des Kanalstücks und Seite b ist 0.6 lang). Die Führungslinien kreuzen dieses Polygon.

Code:

---

Public Function getPolykotierungenForLine(line As AcadLine, ByRef kotierungen As Variant) As Boolean
On Error GoTo ErrorHandler
   
    Dim retval As Boolean
    Dim pointsArray As Variant
    Dim lineset As AcadSelectionSet
    Dim entry As AcadEntity
    Dim leader As AcadLeader
    Dim FType(1)  As Integer
    Dim FData(1) As Variant
    Dim mode As Integer
    Dim leaderCol As Collection
    Dim annotationObject As AcadObject
    Dim mtext As AcadMText
   
   
    retval = False

    'getDrainDirectionFence liefert die Koordinaten für das Polygon um die Linie herum
    'Methode habe ich bereits überprüft, sie funktioniert

    pointsArray = getDrainDirectionFence(line.angle, line.StartPoint, line.endpoint, 0.3)
   
    ' Filter verwende ich im MOment nicht, da er nicht funktioniert
    ' deshalb muss ich die Typen so überprüfen

    '  FType(0) = 0: FData(0) = "Leader"
   
    mode = acSelectionSetCrossingPolygon
    Set lineset = CreateSelectionSet("LINESET")
    lineset.SelectByPolygon mode, pointsArray
         
    Set leaderCol = New Collection
    For Each entry In lineset
      '  Schlechten Typvergleich bitte ignorieren, habe bereits einen Thread für
      '  korrekte Typüberprüfung eröffnet
        If StrComp(entry.ObjectName, "AcDbLeader") = 0 Then
            Set leader = entry
        '    leaderCol.Add leader
           
            Set annotationObject = leader.Annotation
            If annotationObject.ObjectName = "AcDbMText" Then
                retval = True
                Set mtext = annotationObject
            End If
        End If
    Next entry
   
       
    lineset.Clear
    getPolykotierungenForLine = retval
    Exit Function

ErrorHandler:
    Debug.Print "***************************************"
    Debug.Print "Error: " & Error(Err) & Chr(13) & "Function: getPolykotierungenForLine" & Chr(13) & "Description: " & Err.Description & Chr(13) & "Number: " & Err.Number & Chr(13) & "Source: " & Err.Source
    Debug.Print "***************************************"
    Err.Clear
    lineset.Clear
    getPolykotierungenForLine = False
    On Error GoTo 0
End Function

---

Im Anhang findest du einen Screenshot. Die Schächte sind eingekreist. Also ausgehend von diesen Schächten arbeite ich mich mit einer rekursiven Funktion bis zum Ende der Linien und lese die Werte der Führungslinien aus. (Derzeit funktioniert alles, aber ich würde gerne den Filter und eine korrekte Typüberprüfung einbauen).

Lg Peter

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