---

Hallo VBAler,
ist es eigentlich möglich Blöcke zu filtern die ein Attribut mit einem bestimmten Namen haben?

------------------
Roland

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

---

Also ich tät da so vorgehen:

Dim Array1 As Variant
Dim elem As AcadEntity
Dim Count As Long

For Each elem In ThisDrawing.ModelSpace
  If elem.ObjectName = "AcDbBlockReference" Then
    For Count = LBound(Array1) To UBound(Array1)
      If Array1(Count).TagString = "gesuchtes Attribut" Then
              'was immer du willst
      End if
    Next Count
  End If
Next elem

Willst du es gar nur in Blöcken mit bestimmten Namen:

Dim Array1 As Variant
Dim elem As AcadEntity
Dim Count As Long

For Each elem In ThisDrawing.ModelSpace
  If elem.ObjectName = "AcDbBlockReference" Then
    If elem.Name <> "Gewünschter Blockname" Then GoTo NextEl
    For Count = LBound(Array1) To UBound(Array1)
      If Array1(Count).TagString = "gesuchtes Attribut" Then
              'was immer du willst
      End if
    Next Count
  End If
NextEl:
Next elem

wußte halt nicht, ob du den filter auf die zeichnung oder auf das selection set setzen willst, aber das dürfte für dich kein prob sein.
Bernd

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

Bernd

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

---

Danke Bernd,
so ähnlich hatte ich es mir auch überlegt.
Nun bekam ich aber den Vorschlag es doch so zu machen.
Da die Blocknamen ja nicht bekannt sind und ich nur den Attributnamen kenne, laufe ich nun alle Blöcke durch und schau mir an ob das Attribut vorhanden ist.
Wenn das Attribut vorhanden ist, dann kommt das in ein String. Sollte das Attribut in noch einem Block vorhanden sein, für ich den Block einfach an das String hinzu.
Dieses String dient mir dann beim SS als Filter, und schon hab ich nur die Blöcke bei denen dieses Attribut vorhanden ist.

------------------
Roland

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

---

Hallo Roland.

Hier ein kleine Routine, die per Selectionset die Blockreferenzen ausliest. Dieses geht schneller als die gesamte Zeichnung sequenziel zu durchsuchen. Nur musst du später das Selectionset nach dem Attribut durchsuchen. Dieses kannst du mit der Methode GetAttributes erreichen.

On Error Goto AttViewError
  Dim varAttributes As Variant
  Dim ssetObj As AcadSelectionSet
  Dim groupCode As Variant, dataCode As Variant
  Dim gpCode(0) As Integer
  Dim dataValue(0) As Variant

  Set ssetObj = ThisDrawing.SelectionSets.Add("SSET")
 
  gpCode(0) = 0
  dataValue(0) = "Insert"
  groupCode = gpCode
  dataCode = dataValue
   
  ssetObj.Select acSelectionSetAll, , , groupCode, dataCode
  imax = ssetObj.Count
'hier bitte das Selectionset auswerten

Da bei vorhandenen Selectionset ein Laufzeitfehler auftritt, musst du diesen wie folgt abfangen

  Set objRBez = Nothing
  Set ojRbezRef = Nothing
  Set varAttributes = Nothing
  Set ssetObj = Nothing
 
  Exit Function
 
 
AttViewError:
  Select Case err.Number
    Case -2145320851
      ThisDrawing.SelectionSets.Item("SSET").Delete
      err.Clear
      Resume
    Case Else
      mlngErrorNumer = actError.AttNameNotExist
      mstrErrorDescription = actError.AttNameNotExistDes
  End Select

---

Hier der Code den ich jetzt verwenden, das Suchen der Blöcke geht so schnell das es nicht auffällt.

Code:

---

    For Each objBlk In colBlks
        For Each objBlkEntity In objBlk
            If TypeOf objBlkEntity Is AcadAttribute Then
                Set objAttribute = objBlkEntity
                If UCase(objAttribute.TagString) = TagString Then
                  strNamesFilter = strNamesFilter & objBlk.Name & ","
                  Exit For
                End If
            End If
        Next objBlkEntity
    Next objBlk

    Set SS = CreateSelectionSet("Gefaelle3PktAuswahl")

    FltTypes(0) = 0: FltData(0) = "INSERT"
    FltTypes(1) = 2: FltData(1) = strNamesFilter

---

------------------
Roland

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