---

schönen guten Abend an alle Nichtfussballfans :-)

habe folgende VBA Routine die in einer Zeichnung den Block mit dem Namen LOGO suchen soll und die enthaltenen Attribute anzeigen soll.

Private Sub CommandButton19_Click()
  Set allblocks = ThisDrawing.Blocks
  For Each blk In allblocks
    If blk.Name = "LOGO " Then
      MsgBox (blk.Name)
      'Block Attribute auslesen
    End If
  Next
End Sub

Besten Dank für Eure Hilfe

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

---

 

Zitat:

---

schönen guten Abend an alle Nichtfussballfans :-)

---

Ich fühle mich zwar nicht angesprochen, aber ...

Du durchsuchst die Blockdefinitionen. Da gibt es keine Attribute mit Werten. Wenn du nur wissen willst ob die Blockdefinition eine Attributsdefinition hat, musst du alle Entitys in der Blockdefinition durchlaufen.

Wilfried Stelberg

------------------
Warum lisp'eln wenn's auch anders geht. 
www.ib-stelberg.de

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

---

was ich eigentlich möchte ist folgendes :

- block in der dwg suchen
- da ich weiss dass der block attribute hat, diese ausgeben z.B. msgbox, file etc.

diese routine funktioniert, aber ich will den block nicht picken müssen

  ThisDrawing.Utility.GetEntity blk, pickedPoint, "Block picken"
  If blk.HasAttributes = True Then
      If blk.Name = "LOGO" Then
        numfile = Replace(zeichnung, ".dwg", ".num")
        Open numfile For Output As #1
        Write #1, zeichnung
        Block_Attribute = blk.GetAttributes
        For cnt = LBound(Block_Attribute) To UBound(Block_Attribute)
          atttxt = Block_Attribute(cnt).TagString + " : " + Block_Attribute(cnt).textString
          Select Case Block_Attribute(cnt).TagString
            Case "TITEL", "NAME"
              Write #1, atttxt
          End Select
        Next
        Close #1
      End If
  End If

Besten Dank für die Hilfe

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

---

Zitat:

---

Original erstellt von egug:
was ich eigentlich möchte ist folgendes :

- block in der dwg suchen ...aber ich will den block nicht picken müssen

---

Dann mache eine Auswahl (Selection) auf alle Blockreferenzen (Insert) namens "Logo" in der Zeichnung, und Zeige dann die Atribute an.
Hier hats Wilfried schon fix und fertig vorgestellt: http://ww3.cad.de/foren/ubb/Forum259/HTML/001218.shtml#000007

------------------
Mit freundlichem Gruß

Udo Hübner
www.CAD-Huebner.de

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

---

habe nun die Routine von Stelli mal eingebunden, die funktioniert auch :-)

    Dim sset As AcadSelectionSet
    Dim Entity As AcadEntity
    Dim fType%(1), fData(1)
    On Error Resume Next
 
    Set sset = ThisDrawing.SelectionSets("Rahmen")
    If err.Number Then
      Set sset = ThisDrawing.SelectionSets.Add("Rahmen")
    End If
    On Error GoTo 0
   
    fType(0) = 0
    fData(0) = "INSERT"
    fType(1) = 8  ' Layer
    fData(1) = "Layer1"
    fType(1) = 2  ' Blockname
    fData(1) = "LOGO"
   
    sset.Select acSelectionSetAll, , , fType, fData
    For Each Entity In sset
        If Entity.ObjectName = "AcDbBlockReference" Then
          MsgBox Entity.Name
        End If
    Next
    sset.Delete

aber ich verstehe noch nicht, wie ich an die Attribute des selektierten Blocks rankomme

schönen Abend

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

---

VBADoku-GetAttributes.jpg

Benutze doch die Suche hier bei CAD.de - hier hab ich es noch einmal für dich gemacht.
Nancy (startrek) hat da schon mal Beispielcode eingestellt. http://ww3.cad.de/foren/ubb/Forum259/HTML/001048.shtml#000001

Zum Auslesen der Attribute einer Blockreferenz benutzt man die Methode GetAttributes.
Dazu steht in der VBA-Entwickerdoku von AutoCAD (F1) auch ein lauffähiges VBA Programm (siehe Example)

------------------
Mit freundlichem Gruß

Udo Hübner
www.CAD-Huebner.de

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

---

Hallo egug,

brauchst doch nur Deinen ersten obigen Code verwenden und die Zuweisung

blk = Entity

verwenden.

Grüße,
Klaus

[Edit]natürlich nicht den ersten, sondern Deinen zweiten Eintrag. Du ersetzt ja das picken mit der SelectionSet-Auswahl. [\Edit]

[Diese Nachricht wurde von KlaK am 16. Jun. 2008 editiert.]

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

---

zuerst mal besten Dank an alle die mich unterstützt haben. Habs geschafft und hier mal eine Funktionsbeschreibung des Programms.

- suche alle DWG's in einem ausgewählten Directory
- erstelle von jeder gefundenen DWG ein ASCII File von dem Block LOGO mit den
  vorbestimmten Attributen TITEL, ZEICHNUNGSNUMMER, INDEX und DATUM

hier der Programmcode :

Private Sub CommandButton1_Click()
  Dim zeichnung, numfile, atttxt As String
  Dim Objekt As AcadObject, myAtts, att
  Dim j, cnt As Integer
  Dim sNextFile, startfo As String
  Dim oShell, oFolder As Object
  Set oShell = CreateObject("Shell.Application")
  Set oFolder = oShell.BrowseForFolder(HWND, "Ordner auswählen", 1)
  If Not oFolder Is Nothing Then
    cnt = 0
    startfo = oFolder.Self.Path
    sNextFile = Dir$(startfo & "\*.DWG")
    Do While sNextFile <> ""
      ComboBox1.AddItem (startfo & "\" & sNextFile)
      sNextFile = Dir$()
      cnt = cnt + 1
    Loop
    ComboBox1.ListIndex = 0
  Else
    MsgBox ("es wurde kein Ordner ausgewählt")
    Exit Sub
  End If
  For j = 0 To cnt - 1
    ComboBox1.ListIndex = j
    Documents.Open ComboBox1.Text, True
    zeichnung = ThisDrawing.FullName
    numfile = Replace(zeichnung, ".dwg", ".num")
    Open numfile For Output As #1
    Write #1, zeichnung
    For Each Objekt In ActiveDocument.PaperSpace
      If Objekt.ObjectName = "AcDbBlockReference" Then
        If Objekt.Name = "LOGO" Then
          If Objekt.HasAttributes Then _
            myAtts = Objekt.GetAttributes
            For Each att In myAtts
              Select Case att.TagString
                Case "TITEL", " ZEICHNUNGSNUMMER ", "INDEX",  "DATUM"
                    Write #1, (att.TagString & " : " & att.TextString)
              End Select
            Next
          End If
        End If
    Next
    Documents.Close
    Close #1
  Next
  MsgBox ("File wurde erstellt"
End Sub

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