---

Hi zusammen,

nach längerem ergebnislosen Suchen, eine Frage:
Ich möchte folgende Infos über einen Layer in einen Textstring ausgeben (der dann später in eine Textdatei geschrieben wird).
- Layername: LayInhalt = ThisDrawing.Layers("xy")
- Layerbeschreibung: LayInhalt = LayInhalt & Chr(10) & "  " & ThisDrawing.Layers(LayName).Description
- Auf dem Layer vorkommende Objektarten (Polylinien geschlossen, PL offen, Linien, Kreise, ..)
- Flächen der geschlossenen Polylinie
- Summe der geschlossenen Polylinineflächen

- Längen der offenen Polylinine und Linien
- Summe der Längen

Jetzt die Frage:
Wie kann ich die in einem Layer vorkommenden Objekttypen  und deren Anzahl ermitteln und in eine Matrix schreiben (1. Spalte = Objekttyp, 2. Spalte = Anzahl)?

------------------
Christian

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

---

alle Geometrieobjekte aller Blockdefinitionen der Zeichnung durchlaufen und deren LAYER und Objekttyp in eine Liste und die dann auswerten ...

------------------
  - 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

---

Hi,

eine Variante:

Du erstellst Dir eine Klassendefinition, in je Objekttyp Deine gewünschten Eigenschaften gespeichert werden und diese in einem Array oder einer Collection sammeln für nachfolgende Auswertungen.

Die Klassendefinition als elegante Methode kannst Du natürlich durch einen Array ersetzen, ist halt weniger schön, weniger performant und später mal weniger leicht zu modifizieren.

Und dann alle Elemente von Modellbereich durchlaufen und einordnen.

Jetzt stellt sich die Frage für mich: Beantwortet das Deine Frage?

- alfred -

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

---

Hi,

und wenn's nicht um programmieren geht, sondern darum, dass die Elemente ausgegeben werden, dann gäbe es da auch noch.

Befehl: datenextrakt

- alfred -

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

---

Hi ihr zwei,

es geht darum Flächen von geschlossenen Polylinien aus Layern mit bestimmten Buchstabenkombinationen im Layernamen aufzulisten und zu summieren und gleichzeitig mögliche Fehleingaben durch den Benutzer darzustellen. Dieses Ergebnis soll in ein Textfile ausgegeben werden.
Es sollen keine Blockdefinitionen durchlaufen werden.

Das oben beschriebene Modul soll einen bekannten Layernamen, auf den die Layerkriterien zutreffen auswerten und folgenden Textstring als Ergebnis bringen:
''''''''''
Layername xy
  Beschreibung des Layers
    Anzahl der Objekte auf dem Layer:
      davon Kreise: 5
            Polylinien geschlossen: 215
            Polylinien offen: 215
            Linien: 5
            usw.
    Einzelflächen der geschlossenen PL:
      15.25
    126.78
    usw
    Summe der Einzelflächen: xxxxxm2
'''''''''

Dieser Informationsblock soll für jeden angefragten Layer an das übergeordnete Makro übergeben werden und wird von dort aus in das Txt-File geschrieben.

Da ich nicht weiß, welche Objekte der User auf dem Layer gezeichnet hat und ich nicht jedesmal alle Objekte ausgeben möchte mit Anzahl 0, muss ich zuerst ermitteln, was für Objekte gezeichnet wurden und diese dann zählen.

Und da weiß ich nicht weiter. bzw. keine gute Programmschleife.

------------------
Christian

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

---

Hi Christian,

>> Da ich nicht weiß, welche Objekte der User auf dem Layer gezeichnet hat
>> und ich nicht jedesmal alle Objekte ausgeben möchte

Zuerst ein SelectionSet bauen, welches alle Elemente Deines gesuchten Layers enthält.

- Du erzeugst eine leere Liste für Objekttypen (z.B. Array mit Items für 'Anzahl Elemente', 'geschlossen ja/nein bei geschlossenen Polylinien', 'Summenfläche bei geschlossenen Polylinien')

- Du erzeugst eine leere Liste für Flächen geschlossener Polylinien

- Dann gehst Du durch jedes Element in diesem SelectionSet, nimmst mal die Eigenschaft 'ObjectName' des Elements, schaust, ob dieser ObjectName in der ersten Liste schon vorkommt
  wenn nein ==> anlegen und Zähler auf 1 setzen (bei geschl. Poly Fläche setzen)
  wenn ja, Zaehler in der ersten Liste hochzählen (bei geschl. Poly Fläche summieren)

- wenn geschlossene Poly, dann in zweitem Array neue Zeile mit Fläche hinzufügen

Und bist Du dann durch das SelectionSet durch, brauchst Du 'nur mehr' die Inhalte der beiden Listen in TXT-Dateien rausschreiben lassen.

- alfred -

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

---

Hi alfred,

danke für die Hinweise.

Hier mal der aktuelle Stand meines Codes zum Drüberschauen.

Code:

---

Sub TestGetLayInhalt()
    GetLayInhalt "XY"
End Sub
Sub GetLayInhalt(LayName As String)
'Alle Objekte des Layers LayName darstellen
'Eingangswert: Name eines vorhandenen Layers
    MsgBox LayName & " wird geprüft.", , "Löschen"
   
    Dim LayInhalt As String 'Enthält die komplette Beschreibung (Text) des Layers sammt seines Inhalts
    'Erste Zeile des Strings = Layername
    LayInhalt = LayName
   
    'Beschreibung des Layers auslesen
    'Laybeschreibung = ThisDrawing.Layers(LayName).Description
    LayInhalt = LayInhalt & Chr(10) & "  " & ThisDrawing.Layers(LayName).Description
   
    'Alle Objektarten (Polylinie, Linien, Kreise, ...) ermitteln und ausgeben.
       
    'Auswahlsatz mit allen Objekten des Layers bilden
    Dim ssAllLayObj As AcadSelectionSet
    Dim Objekt As AcadObject
   
    Dim FilterType(0) As Integer
    Dim FilterData(0) As Variant

    'Auswahlsatz löschen, falls vorhanden. Fehlerabfang, wenn nicht vorhanden
    On Error Resume Next
    ThisDrawing.SelectionSets.Item("AllLayerObj").Delete
    On Error GoTo 0
   
    'Auswahlsatz neu bilden
    Set ssAllLayObj = ThisDrawing.SelectionSets.Add("AllLayerObj")
    FilterType(0) = 8        'Filter nach Layer
    FilterData(0) = LayName  'Layername
   
    'Alle Objekte des Layers in den Auswahlsatz aufnehmen
    ssAllLayObj.Select acSelectionSetAll, , , FilterType, FilterData
   
    'Prüfen, wieviel Objekte im Auswahlsatz sind
    Dim ObjAnz As Integer
    ObjAnz = ssAllLayObj.Count
   
    'Anzahl der Objekte in Ausgabetext schreiben
    LayInhalt = LayInhalt & Chr(10) & "    " & ObjAnz & " Layerobjekte:"
       
    'Auswahlsatz durchgehen und vorhandene Objektarten ermitteln
    Dim Layerobjektarten() As Variant 'Liste mit 2 Spalten für Objektart und Anzahl
    ReDim Layerobjektarten(1, 0)
    Dim intI As Integer, intJ As Integer, intJmax As Integer
    intJ = 0
   
    For Each Objekt In ssAllLayObj
        'Zählen, wieviele Objektarten es bereits gibt.
        intJmax = UBound(Layerobjektarten, 2)
       
        'Alle bekannten Objektarten durchgehen und mit der aktuellen Objektart vergleichen
        For intJ = 0 To intJmax
            If Objekt.ObjectName = Layerobjektarten(0, intJ) Then
                'Objektart ist bereits bekannt
                'Anzahl muss erhöht werden
                Layerobjektarten(1, intJ) = Layerobjektarten(1, intJ) + 1
                Exit For

            ElseIf intJ = intJmax And Not Objekt.ObjectName = Layerobjektarten(0, intJ) Then
                'Erst beim letzten intJ ausführen
                'Wenn es die Objektart noch nicht gibt, dann der Liste hinzufügen
                'Datenfeld um 1 erweitern
                intI = intJ + 1
                ReDim Preserve Layerobjektarten(1, intI)
                'Neue Objektart hinzufügen
                Layerobjektarten(0, intI) = Objekt.ObjectName
                'Anzahl des ersten neuen Objekts einfügen
                Layerobjektarten(1, intI) = 1
            End If

        Next intJ
       
    Next 'For Each Schleife
   
    'Ergebnis in den Ausgabestring schreiben
    For intJ = 1 To UBound(Layerobjektarten, 2)
        LayInhalt = LayInhalt & Chr(10) & "      " & Layerobjektarten(1, intJ) & " " & Layerobjektarten(0, intJ)
    Next

---

Muss sich jetzt die Flächenermittlung aller Polylinien bzw. geschlossenen Polylinien anschließen.

Dazu die Fragen:
Wie bilde ich einen Auswahlsatz aus einem Auswahlsatz?
Wie ermittler ich, ob eine PL geschlossen ist oder nicht?
Und wie ermittle ich die Fläche der Polylinie in einer For Each Schleife?

------------------
Christian

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

---

Hi Christian,

wirst nicht viel wiedererkennen, aber beantwortet Deine Fragen:

Ab Deiner For-Next-Schleife für SelectionSet-Durchlauf tauschen:

Code:

---

    Dim tObjektArten As Collection    'Collection vom Typ: ObjDetailType
    Set tObjektArten = New Collection
   
    Dim tItem As cObjDetail            'ein einzelner Eintrag
     
    For Each Objekt In ssAllLayObj
      'zuerst sehen wir nach, ob fuer den Objektyp schon in der Collection ein Eintrag existiert
      Set tItem = Nothing              'zuruecksetzen
      On Error Resume Next
      Set tItem = tObjektArten.Item(Objekt.ObjectName)
      On Error GoTo 0
      If tItem Is Nothing Then
        'dann muessen wie ein neues Item anlegen
        Set tItem = New cObjDetail
        'und der collection hinzufuegen
        Call tObjektArten.Add(tItem, Objekt.ObjectName)
      End If
     
      'und werte befuellen
      Call tItem.fillData(Objekt)
     
    Next 'For Each Schleife
 
    'Ergebnis in den Ausgabestring schreiben
    For Each tItem In tObjektArten
      LayInhalt = LayInhalt & Chr(10) & tItem.getOutputLine
    Next

---

Und dann bitte noch ein KlassenModul anlegen mit dem Namen 'cObjDetail' mit folgendem Code:

Code:

---

Option Explicit

Private pObjectName As String
Private pCount As Integer
Private pAreaSum As Double

Public Sub fillData(ByRef Ent As AcadEntity)
  pObjectName = Ent.ObjectName              'Elementart
  pCount = pCount + 1                      'Anzahl der Elemente um eins erhoehen
  If Ent.ObjectName Like "*Poly*" Then      'wenn Polylinie und geschlossen, dann Flaeche kumulieren
      If Ent.Closed Then
        pAreaSum = pAreaSum + Ent.Area
      End If
  End If
End Sub

'retourniert den Inhalt in Textform fuer Ausgabe
Public Function getOutputLine() As String
  Const Sep As String = "|"                'Seaparator zwischen den Spalten
  Dim tRetVal As String
  tRetVal = pObjectName                    'Objekttyp
  tRetVal = tRetVal & Sep & pCount          'Anzahl
  If pAreaSum > 0 Then
      tRetVal = tRetVal & Sep & pAreaSum    'Flaeche
  End If
  getOutputLine = tRetVal
End Function

---

Viel Erfolg, - alfred -

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

---

hi alfred,

hast Recht. Ich erkenne nicht viel wieder.
Erst mal vielen herzlichen Dank.

Grüße

------------------
Christian

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