---

Hallo Zusammen,

Da meine Fragen jetzt langsam garnichts mehr mit meinem letzten Thema zu tun haben mach ich jetzt mal für bessere Übersicht ein neuen Beitrag auf.

Also in diesem Code will ich in Koord (Das sind Punkte von einem Umring) ein feld (geschlossene Polylinie) platzieren, inwiefern dieses nicht über die Grenzen hinausgeht.

Mein Problem ist, dass ich das Handling mit Selectionsets usw. noch nicht so ganz raus habe.
Es wird wenn ich ein feld platziert habe keines gefunden.

Ich hab mir schon andere Beispiele angesehen und versucht da einiges rauszubekommen - hat anscheinend nicht so geklappt  .

In einem anderen Beitrag habe ich auch schon gelesen, dass es bei selectbypolygon zu Problemen kommen kann.

Also ich wäre sehr dankbar wenn über den Code mal jemand drüberschaun kann und Verbesserungen (aller Art!) nennen würde (Da ich noch Anfänger bin)

    Dim i As Long
    Dim Points(11) As Double
    Dim feld As Acad3DPolyline
    Dim ssetobj As AcadSelectionSet
    Dim Spunkt As Variant
    Dim Abbruch As Boolean
    Dim Koord() As Double
   
    Do
    On Error Resume Next
        If Err.Number = 0 Then
           
...
           
            On Error GoTo 0
           
                'feld platzieren um im Umkreis zu suchen
                Set feld = ThisDrawing.ModelSpace.Add3DPoly(Points)
                feld.Visible = False
                feld.Closed = True
               
                'Alle Objekte die in dem Umring sind in Selectionset schreiben
                Set ssetobj = CreateSelectionSet()
                ssetobj.SelectByPolygon acSelectionSetWindowPolygon, Koord
                On Error GoTo 0
               
                'Wenn das feld bei den Objekten die in dem Umkreis sind gefunden wird -> sichtbar machen ansonsten löschen
                If ssetobj.Count > 0 Then
                    For i = 0 To ssetobj.Count - 1
                        If ssetobj(i).ObjectID = feld.ObjectID Then
                            feld.Visible = True
                        End If
                    Next i
                       
                    If feld.Visible = False Then
                        MsgBox "feld ist draußen"
                        feld.Delete
                    End If
                Else
                    MsgBox "feld ist draußen"
                    feld.Delete
                End If

        Else
            Abbruch = True
        End If
    Loop Until Abbruch

Danke euch im Voraus 

Grüße

Silvan

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

---

Hi,

ich kenne das Ziel nicht (und verstehe das leider auch nicht aus der Beschreibung heraus), aber 2 Dinge fallen auf:

a) Du hast den Hinweis bzgl. SelectionSet und Zoom schon gelesen ==> aber hier nicht umgesetzt (sehe zumindest kein Zoom)

b) wenn Du mit (extrem) grossen Datenmengen hantierst, dann ist

  For i = 0 to ssetObj.Count-1

langsamer als

  dim tEnt as AcadEntity
  For each tEnt in ssetObj

-------------------------

Und geht es darum, beispielsweise Fliesen in einer Umgrenzung aufzuteilen, dann schau dir von den ExpressTools mal den Befehl 'SuperHatch' an.

- alfred -

------------------
www.hollaus.at

---

Hi,

1)Der Befehl SuperHatch kommt schon ziemlich gut an das gesuchte.
Das Problem dabei ist, dass es nur eine ich sag mal "grafische"-Lösung ist.
Ich würde es gerne so lösen, dass ich so wenige wie mögliche Fliesen (in meinem Beispiel Felder) zerschneiden muss und die zerschnittenen auch nicht anzeigen will.
Außerdem will ich mit den einzelnen Fliesen noch umgehen können und nicht alle als Gruppe haben. (Hab auch Hier gelesen, das es möglich ist aber bei mir klappt des trotzdem nicht.

2)Zu dem Zoom habe ich um ehrlich zu sein keine Ahnung welchen ich anwenden soll. Ich hätte mich jetzt für den ZoomCenter entschieden und dann vom Scheitelpunkt meines Polygons weggezoomt? 
Muss noch dazusagen, dass ich nicht richtig nach Zoom hier suchen konnte, da die Suchfunktion irgendwie nicht funktioniert hat.

3) Das mit dem AcadEntity hab ich eingebaut danke 

Grüße Silvan

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

---

Hi Sivian,

zu 1) kann nix dazu sagen, das heisst Mathematik, Geometrie, und rechnen 

zu 2) Von Deiner Umgrenzung (Polylinie) kannst Du Dir die Extents ausrechnen lassen und dann mit Zoom_Window auf diese Grenzen zoomen (und dann ev. noch Zoom 0.9x)

- alfred -

------------------
www.hollaus.at

---

Hey,

danke erstmal hab jetzt nen Zoom eingebaut der ganz gut funktioniert!

In meinem Programm habe ich das Feld jetzt als Blockref genommen. Ich will mehrere Felder nacheinander platzieren und jedesmal überprüfen, ob das Feld innerhalb meines Umkreises ist.

Ich habe aber das Gefühl, dass ich dann den Vergleich mit ObjectID zur Abfrage, ob das Feld innerhalb ist, streichen kann, da die ObjektID der Blockref meines Feldes immer gleich ist oder?
Gibts da noch ne ander Vergleichslösung?

@Alfred danke für deine Hilfe! - mein Name ist Silvan, nicht Sivian 

Grüße

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

---

Hi Silvian, 

Zitat:

---

mein Name ist Silvan, nicht Sivian

---

...bitte vielmals um Entschuldigung.

Zitat:

---

dass ich dann den Vergleich mit ObjectID zur Abfrage, ob das Feld innerhalb ist, streichen kann

---

tut mir leid, ich krieg Deinen oben dargestellt Code nicht in mein Hirn und daher hilft mir auch nichts, es zu probieren, da ich nicht alle Grundangaben habe.

Zudem hast Du auch schon einiges an Code geändert. Wenn möglich, stell bitte mal den aktuellen Code und eine Musterzeichnung (damit auch die Blockdefinition angesehen werden kann, von der Du jetzt sprichst) hier zu r Verfügung, dann geht's (hoffentlich) weiter und tiefer. 

- alfred -

------------------
www.hollaus.at

---

AutoCAD.JPG

Hallo,

Im Anhang ist ein Bild in dem Umkreis möchte ich verschieden viele Felder einfügen, die sich nicht mit anderen schneiden.

Die Hauptfrage ist, wie kann ich die Auswahl(markierte Zeile) verbessern?

also hier folgt mein Code 

    Dim feld As AcadBlockReference
    Dim Spunkt As Variant
    Dim i As Long
    Dim ssetobj As AcadSelectionSet
    Dim Abbruch As Boolean
    Dim Koord() As Double
    Dim tEnt As AcadEntity
    Dim LU(2) As Double
    Dim RO(2) As Double

    Do
        If UBound(Punkte()) = 0 Then
            MsgBox "Bitte Umring wählen"
            Exit Sub
        Else
            Koord = PunkttyptoArray(Punkte())
        End If
           
        'Punkt wählen
        Me.Hide
        On Error Resume Next
        Spunkt = ThisDrawing.Utility.GetPoint(, Chr(10) & "Punkt klicken: ")
            If Err.Number Then
                Exit Sub
            End If
        Set feld = ThisDrawing.ModelSpace.InsertBlock(Spunkt, "C:\Test\Modul1\feld(Block).dwg", 1, 1, 1, 0)
        feld.Visible = False
        Me.Show

        'Zoomen um sicher zu gehen, dass select funktioniert
            'Punkte für ZoomWindow festlegen...
            LU(0) = Twert(Punkte()).Hochwert - 100
            LU(1) = Lwert(Punkte()).Rechtswert - 100
            LU(2) = 0
            RO(0) = Hwert(Punkte()).Hochwert + 100
            RO(1) = Rwert(Punkte()).Rechtswert + 100
            RO(2) = 0
            ZoomWindow LU, RO
           
        'Alle Referenzen der Objekte die den Umring schneiden in Selectionset schreiben
        Set ssetobj = CreateSelectionSet()
        ssetobj.SelectByPolygon acSelectionSetWindowPolygon, Koord
        On Error GoTo 0

            'Wenn in das feld bei den Referenzen die den Umkreis schneiden gefunden wird -> löschen
                If ssetobj.Count > 0 Then
                    For Each tEnt In ssetobj
                        If ssetobj(i).ObjectID = feld.ObjectID Then
                            feld.Visible = True
                        End If
                    Next tEnt

                    If feld.Visible = False Then
                        MsgBox "feld ist draußen"
                        feld.Delete
                        Abbruch = True
                    End If
                Else
                    MsgBox "feld ist draußen"
                    feld.Delete
                    Abbruch = True
                End If

    Loop Until Abbruch
    On Error GoTo 0

Grüße

Silvan

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

---

Hi,

jetzt verstehe ich langsam, folgende Verbesserungen sind für Deinen Code möglich:

a) das SelectionSet mit Filter bauen (z.B. dass nur BlockReferenzen gefiltert werden, wenn die Blocknamen auch noch alle gleich sind, dann auch noch danach), dann muss nicht die ganze Zeichnung (alle Geometrieelemente) durchgescannt werden

b) wenn Du im IF die richtige ObjectID gefunden hast, dann mit 'Exit For' die Schleife verlassen, denn Du hast die gesuchte Antwort schon, da braucht er nicht weitersuchen.

c) und wenn's noch schneller gehen soll, dann vor Bildung des SelectionSets mal grundsätzlich mit den Extents der Polylinie vergleichen, soll heissen, wenn der Anwender einen Punkt gezeigt hat und dieser Punkt schon mehr links liegt, als die ExtentsMinima der Polylinie liegen (und das gleiche für rechts, oben, unten), dann kann der Block schon nicht mehr drin liegen, dann ersparst Du Dir das SelectionSet anlegen und auch den Block einfügen, um diesen nachher wieder zu löschen.

- alfred -

------------------
www.hollaus.at

---

Hi,

zu a) innerhalb des Polygons sind nur diese Blöcke.

zu b) Das "Exit For" is drin.
Aber genau dieses IF möchte ich umstellen, da die ObjectID von der BlockRef meines Feldes doch immer gleich bleibt oder?
Ich habs jetzt mal versucht so zu lösen:

                If ssetobj.Count > 0 Then
                    For Each tEnt In ssetobj
                        If ssetobj(I).Insertpoint = feld.Insertpoint Then
                            feld.Visible = True
                            Exit For
                        End If
                    Next tEnt

                    If feld.Visible = False Then
                        MsgBox "feld ist draußen"
                        feld.Delete
                        Abbruch = True
                    End If
                Else
                    MsgBox "feld ist draußen"
                    feld.Delete
                    Abbruch = True
                End If

funktioniert aber leider auch nicht.
Fehlermeldung sagt: Typen unverträglich.
Welchen vergleich sollte ich da am besten machen mit ".GetAttributes" hab ichs auch versucht.

zu c) auch eingebaut.

Grüße

Silvan

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

---

Hi Silvian,

ohne jetzt Code zu schreiben, versuche ich, Deinen zu beschreiben:

Es gibt eine Polylinie, deren Array von Koordinaten in <Koord> gespeichert ist.

Du forderst den Anwender auf, einen Punkt zu zeigen, an dem Du danach eine BlockReference <feld> einsetzt.

Jetzt beginnst Du mit der Prüfung, ob dieser Block innerhalb der <Koord>-Liste liegt:

Du erstellst ein SelectionSet um alle Elemente innerhalb der Koordinatenliste zu sammeln (die Polylinie darf also nicht durch Bögen begrenzt sein, nur gerade Segmente, da Du ein SelectionSet baust, das alle Elemente innerhalb der Koordinatenliste sucht)

Dann gehst Du das SelectionSet durch und suchst, ob Deine BlockReference <feld> darin vorkommt, und da stehen wir jetzt:

Der sinnvollste Vergleich kann über Handle oder über ObjectID gehen, wieso willst Du über den Einfügepunkt gehen (wo Du beim Vergleich erstens X und Y und Z vergleichen müsstest, Deine Fehlermeldung sagt indirekt, dass Array's nicht mit '=' verglichen werden können, und zweitens mit der endlichen Anzahl von Dezimalstellen immer mit einer Toleranz rechnen solltest), das kostet nur bedeutend mehr Kraft (3 Doubles vergleichen ist eine Vielzahl von CPU-Steps verglichen mit einem Long-Wert oder einem (kurzen) String.

Zitat:

---

Ich habe aber das Gefühl, dass ich dann den Vergleich mit ObjectID zur Abfrage, ob das Feld innerhalb ist, streichen kann, da die ObjektID der Blockref meines Feldes immer gleich ist oder?

---

...das verstehe ich eben nicht, denn wenn die Prozedur ein zweites mal angestartet wird, wird eine neue BlockReference gesetzt und die hat eine andere ObjectID, wieso sollte diese gleich sein?

- alfred -

------------------
www.hollaus.at

---

Hi Silvian,

mal wie ich es gemacht hätte:

Code:

---

Const BlRefName As String = "KM"
Const BlRefScale As Double = 1
Const BlRefRot As Double = 0

Public Sub FieldInsert()
   Dim tPoly As AcadLWPolyline
   Dim tPnt As Variant
   Dim tCoords As Variant
   Dim tInsPnt As Variant
   Dim tSSet As AcadSelectionSet
   Dim tBlRef As AcadBlockReference
  
   On Error Resume Next
  
   Call ThisDrawing.Utility.GetEntity(tPoly, tPnt)
   If tPoly Is Nothing Then
      Call MsgBox("Keine Polyline selektiert, Abbruch")
   Else
      Dim tMinExt As Variant
      Dim tMaxExt As Variant
      Call tPoly.GetBoundingBox(tMinExt, tMaxExt)
  
      Err.Clear
      tInsPnt = ThisDrawing.Utility.GetPoint(, vbNewLine & "Einfügepunkt Feld: ")
      If Err.Number <> 0 Then
         'oops, user hat scheinbar abgebrochen
      Else
         'jetzt pruefen wir, ob der punkt ausserhalb der extents liegt
         Dim tIsOutside As Boolean
         If (tInsPnt(0) < tMinExt(0)) Or (tInsPnt(1) < tMinExt(1)) Then
            tIsOutside = True
         ElseIf (tInsPnt(0) > tMaxExt(0)) Or (tInsPnt(1) > tMaxExt(1)) Then
            tIsOutside = True
         End If
        
         If Not tIsOutside Then
            'ok, dann fuegen wir die BlockReference mal testweise ein
            Set tBlRef = ThisDrawing.ModelSpace.InsertBlock(tInsPnt, BlRefName, BlRefScale, BlRefScale, BlRefScale, BlRefRot)
            If tBlRef Is Nothing Then
               Call MsgBox("Block zum Einfügen nicht gefunden, Abbruch")
            Else
               'dann bauen wir SelectionSet und pruefen, ob die BlockReference gefunden wird
               'zuerst umwandeln der Polylinien-Koordinaten in SSet-Koordinaten
               tCoords = getLwPlineVertizes(tPoly)
               'dann erstellen wir einen Filter, der nur auf den Blocknamen filtert
               Dim tDxfCode(1) As Integer: tDxfCode(0) = 0: tDxfCode(1) = 2 'Blockname
               Dim tDxfValue(1) As Variant: tDxfValue(0) = "INSERT": tDxfValue(1) = BlRefName
               'jetzt zoomen wir zu den Extents der Polylinie
               Call ThisDrawing.Application.ZoomWindow(tMinExt, tMaxExt)
               'und jetzt das SelectionSet bauen
               Set tSSet = ThisDrawing.SelectionSets.Add("TempSSET")
               If tSSet Is Nothing Then Set tSSet = ThisDrawing.SelectionSets.Item("TempSSET")
               tSSet.Clear
               Call tSSet.SelectByPolygon(acSelectionSetWindowPolygon, tCoords, tDxfCode, tDxfValue)
               If tSSet.Count > 0 Then
                  tIsOutside = True
                  Dim tScanEnt As AcadBlockReference
                  For Each tScanEnt In tSSet
                     If tScanEnt.Handle = tBlRef.Handle Then
                        tIsOutside = False
                        Exit For
                     End If
                  Next
               Else
                  'der block ist ausserhalb
                  tIsOutside = True
               End If
            End If
         End If
        
         If tIsOutside Then
            If (tBlRef Is Nothing) Then tBlRef.Delete: Set tBlRef = Nothing
            Call MsgBox("Feld ist nicht vollständig innerhalb der Polylinie")
         End If
      End If
   End If
End Sub

Private Function getLwPlineVertizes(ByRef Pline As AcadLWPolyline) As Variant
   Dim tRetVal() As Double
   Dim tTempCoords As Variant
   tTempCoords = Pline.Coordinates
  
   'umwandlung von 2d auf 3d Koordinaten
   Dim tIndexMax2D As Integer
   tIndexMax2D = UBound(tTempCoords)
  
   ReDim tRetVal(((tIndexMax2D + 1) / 2 * 3) - 1)
   Dim i As Integer
   For i = 0 To tIndexMax2D Step 2
      tRetVal(i / 2 * 3) = tTempCoords(i)
      tRetVal(i / 2 * 3 + 1) = tTempCoords(i + 1)
      tRetVal(i / 2 * 3 + 2) = 0
   Next
  
   'und jetzt noch schliessen
   ReDim Preserve tRetVal(UBound(tRetVal) + 3)
   tRetVal(UBound(tRetVal) - 2) = tRetVal(0)
   tRetVal(UBound(tRetVal) - 1) = tRetVal(1)
   tRetVal(UBound(tRetVal) - 0) = tRetVal(2)
  
   getLwPlineVertizes = tRetVal
End Function

---

- alfred -

------------------
www.hollaus.at

[Diese Nachricht wurde von a.n. am 15. Mai. 2009 editiert.]

---

Hi alfred,

1000 Dank erstmal, dass du dir so viel Mühe gemacht hast!

Ich Teste das jetzt mal .

Grüße

Silvan

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