---

Hallo,
ich habe das Problem, per VBA innerhalb eines Blockes die Objekte auf einem vorher festgelegten Layer in eine Auswahl zu übernehmen. Die Ausdehnung der Objekte soll dann mit GETBOUNDINGBOX festgestellt werden.
Hat jemand eine Idee, wie ich die Objekte innerhalb eines Blockes selektieren kann?

Danke schon mal
Martin

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

---

Hallo Martin,

Erst einmal Herzlich wilkommen im Forum.
Zu deiner Frage: Wo hakt es denn?!

Umd an die einzelnen Elemente in einem Block zu gelangen kannst du folgenden Code nutzten:

Public Sub Testblock()
Dim Block As AcadBlock
Dim Object As AcadObject
Dim Ausgabe As String
Dim Pickedpoint As Variant
On Local Error Resume Next
Ausgabe = "Objekt wählen:"
ThisDrawing.Utility.GetEntity Object, Pickedpoint, Ausgabe
Set Block = ThisDrawing.Blocks(Object.Name)
'Ab hier enthält "Block" die einzelnen Elemente des Blocks
End Sub

Danach kannst du die Elemente, die auf dem passenden Layer liegen ja zusammenfassen und dann die maximale Ausdehnung bestimmen.

Gruß, Carsten

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

---

Hallo Carsten,
erst mal vielen Dank für Deine Antwort.

Den Programmcode habe ich wie folgt erweitert:

Code:

---

    Dim Min, Max, AllMin, AllMax As Variant
    Dim XMax, YMax As Single
    Dim Durchlauf As Boolean
    Durchlauf = False
    For i = 0 To Block.Count - 1
        If Block.Item(i).Layer = "SCHNIK" Then
            'Hole maximale Ausmaße des Blockobjektes
            Block.Item(i).GetBoundingBox Min, Max
       
            'Beim ersten Durchlauf der Schleife
            If Durchlauf = False Then
                AllMin = Min
                AllMax = Max
                Durchlauf = True
            End If
           
            'Abfrage ob Maximalgrenzen überschritten werden
            If Min(0) < AllMin(0) Then AllMin(0) = Min(0)
            If Min(1) < AllMin(1) Then AllMin(1) = Min(1)
            If Max(0) > AllMax(0) Then AllMax(0) = Max(0)
            If Max(1) > AllMax(1) Then AllMax(1) = Max(1)
        End If
    Next i

XMax = AllMax(0) - AllMin(0)
YMax = AllMax(1) - AllMin(1)
MsgBox XMax & " / " & YMax

---

XMax und Ymax enthalten nun die Absoluten Ausmaße der Elemente auf dem Layer "SCHNIK".

Leider funktioniert das Ganze nicht mit Blöcken deren Einfügefaktor geändert wurde.

Bin für weitere Tipp's offen.

Grüße
Martin

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

---

Hallo Carsten,

habe das Programm hinsichtlich der X/Y-Scalierung nochmal überarbeitet. Hier nun die aktuelle Fassung:

Code:

---

    Dim Block As AcadBlock
    Dim BlockRef As AcadBlockReference
    Dim Object As AcadObject
    Dim Ausgabe As String
    Dim Pickedpoint As Variant
    On Local Error Resume Next
    Ausgabe = "Objekt wählen:"
    ThisDrawing.Utility.GetEntity Object, Pickedpoint, Ausgabe
    Set BlockRef = Object
    Set Block = ThisDrawing.Blocks(Object.Name)
    'Ab hier enthält "Block" die einzelnen Elemente des Blocks
   
    Dim Min, Max, AllMin, AllMax As Variant
    Dim XMax, YMax As Single
    Dim Durchlauf As Boolean
    Durchlauf = False
    For i = 0 To Block.Count - 1
        If Block.Item(i).Layer = "SCHNIK" Then
            'Hole maximale Ausmaße des Blockobjektes
            Block.Item(i).GetBoundingBox Min, Max
       
            'Beim ersten Durchlauf der Schleife
            If Durchlauf = False Then
                AllMin = Min
                AllMax = Max
            End If
           
            'Abfrage ob Maximalgrenzen überschritten werden
            If Min(0) < AllMin(0) Then AllMin(0) = Min(0)
            If Min(1) < AllMin(1) Then AllMin(1) = Min(1)
            If Max(0) > AllMax(0) Then AllMax(0) = Max(0)
            If Max(1) > AllMax(1) Then AllMax(1) = Max(1)
            Durchlauf = True
        End If
    Next i

XMax = (AllMax(0) - AllMin(0)) * BlockRef.XScaleFactor
YMax = (AllMax(1) - AllMin(1)) * BlockRef.YScaleFactor
MsgBox XMax & " / " & YMax

---

Damit ist meine Frage beantwortet und ich darf mich für Deine Hilfe bedanken! 10 Unities sind unterwegs.

Gruß
Martin

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