---

Hallo zusammen,

gibt es VBA Objekte bzw. die Möglichkeit um die Attribute von Blöcken in einer Referenzzeichnung auszulesen?

------------------
MfG Lary 

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

---

was gefällt dir dann an dieser Antwort nicht? Das läßt ähnlich sicher auch nach VBA portieren..

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

---

Hallo Thomas,

die Antwort ist Klasse und funktioniert genauso wie ich mir das Vorstelle. Unser Problem ist jetzt das bei uns ein Kollege ein großes Kabelmanagement in Access programmiert hat und wir diese Geschichte gerne darin einbinden möchten. Er konnte leider die LISP Variante nicht verwenden. Er grübelt jetzt seit drei Tagen über diesem Problem und kommt damit nicht wieter, daher halt meine Frage an dieser Stelle.

Gruß Lary

------------------
MfG Lary 

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

---

Also ne Verbindung.. Xref-Attribute-Access.. ist gewünscht.. geht auch mit Lisp und ActivX .. IMHO hat Holger Brischke in der Hinsicht mal was gemacht. Vielleicht solltest du dich mal mit ihm per PM in Verbindung setzen.

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

---

Danke Thomas, werde ich machen.

------------------
MfG Lary 

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

---

Hallo Lary,

die Attributte der Xref könnest du so auslesen:

Code:

---

Dim FType(0) As Integer
Dim FData(0) As Variant
Dim FilterType As Variant
Dim FilterData As Variant

Dim xref As AcadBlock
Dim BlockRef As AcadBlockReference
Dim BlockDef As AcadBlock
Dim BlockInXref As AcadBlockReference
Dim Entity As AcadEntity
Dim SelSet As AcadSelectionSet

On Error Resume Next
Set SelSet = ThisDrawing.SelectionSets("MySel")
If Err.Number <> 0 Then
  Set SelSet = ThisDrawing.SelectionSets.Add("MySel")
End If
On Error GoTo 0

FType(0) = 0
FData(0) = "INSERT"
FilterType = FType
FilterData = FData

SelSet.Clear
SelSet.Select acSelectionSetAll, , , FilterType, FilterData

For Each BlockRef In SelSet
    Set BlockDef = ThisDrawing.Blocks(BlockRef.Name)
    If BlockDef.IsXRef Then
      Set xref = BlockDef
      For Each Entity In xref
          If Entity.EntityType = acBlockReference Then
              Set BlockInXref = Entity
              Debug.Print BlockInXref.Name & " hat Attributte: " & IIf(BlockInXref.HasAttributes, "JA", "Nein")
          End If
      Next Entity
    End If
Next BlockRef

---

Stelli

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

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

---

Hallo Stelli,

erstmal vielen Dank für Deine Antwort. Dein Lösungsvorschlag gibt eine Liste aller Attribute aller Blöcke der Referenzzeichnng aus. Wir wollen allerdings noch einen Schritt weiter gehen. Es sollen nur die Attribute eines per Mausklick bestimmten Blocks der Referenzzeichnung ausgegeben werden

Gruß Lary

------------------
MfG Lary 

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

---

Hallo Larry,

ich wüsste nicht wie man in einer Xref einen Block
auswählen kann.

Eine Möglichkeit wäre Über Getpoint eine Koordinate
zu lesen und diese Koordinate mit den Einfügepunkten
in der Xref zu prüfen.

Stelli1

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

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

---

Hallo zusammen,

erstmal vielen Dank für eure sehr hilfreichen Antworten. Wir haben das Problem letztendlich folgendermaßen gelöst:

Sub XrefBlock_auswählen()

Dim ACBlockRef As AcadBlockReference
Dim elem As AcadObject
Dim Array1 As Variant
Dim Count As Integer
Dim i As Integer
Dim Object As AcadEntity
Dim PickedPoint As Variant, TransMatrix As Variant, ContextData As Variant

ThisDrawing.Utility.GetSubEntity Object, PickedPoint, TransMatrix, ContextData, "Bitte wählen Sie einen Stutzen oder eine Bahn aus ! "
Set elem = ThisDrawing.ObjectIdToObject(Object.OwnerID)
If TypeOf elem Is AcadBlockReference Then
    Set ACBlockRef = elem
        If ACBlockRef.HasAttributes Then
            Array1 = ACBlockRef.GetAttributes
            Count = UBound(Array1)
            i = 0
            Do Until i = Count + 1
                Select Case Array1(i).TagString
                    Case "STUTZENBEZEICHNUNG"
                        Gerät = Array1(i).TextString
                        ThisDrawing.Utility.Prompt "Die Stutzenbezeichnung lautet:" & Gerät
                End Select
                i = i + 1
            Loop
    End If
End If

End Sub

------------------
MfG Lary 

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