---

Hallo zusammen,

wie kann man in Excel per VBA abfragen, welche Blöcke in der aktiven Zeichnung vorhanden sind?

Danke im voraus.

------------------
Gruß, Bernhard F.

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

---

Hallo Bernhard,

was willst du denn machen ?

Willst du wissen welche Blockdefinitionen in der Datei sind ?
oder welche Blöcke wieoft eingefügt wurden ?

Mit welcher AutoCAD Version arbeitest du ?
Fülle doch noch bitte die Systeminfo aus.

In Thisdrawing.Blocks hast du eine Auflistung der Blockdefinitionen.
Wenn du die Referenzen haben willst kannst du z.B. die Auflistung des Modelbereiches durchlaufen und die Inserts finden, oder mit Hilfe eines Selectionsets mit einem Filter die Blockreferenzen finden.

Was hast du denn bereits für einen Code.

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

---

Hallo Wilfried,
ich will nur wissen welche Blöcke sich in der Zeichnung befinden. (Auflistung der Blocknamen).

Code:

---

  Dim acad As AcadApplication
  Dim fType(0 To 1) As Integer, fData(0 To 1)
  Dim adBlockSS As AcadSelectionSet
  Dim adBlock As AcadBlockReference
  Dim adBlockAttributes As Variant
  Dim adBlockList As String
  Dim i As Integer

  Set adBlockSS = acad.ActiveDocument.SelectionSets("adBlockSS")
hier ist der Fehler

  If Err Then Set adBlockSS = acad.ActiveDocument.SelectionSets.Add("adBlockSS")
  adBlockSS.Clear
  fType(0) = 0: fData(0) = "INSERT": fType(1) = 2: fData(1) = "*"
  adBlockSS.Select acSelectionSetAll, , , fType, fData
  adBlockList = ""
  For Each adBlock In adBlockSS
    adBlockAttributes = adBlock.GetAttributes
    adBlockList = adBlockList & adBlock.Name & " : "
    For i = LBound(adBlockAttributes) To UBound(adBlockAttributes)
      adBlockList = adBlockList & adBlockAttributes(i).TextString & ", "
    Next i
    adBlockList = adBlockList & vbCrLf
  Next adBlock
  MsgBox adBlockList
  adBlockSS.Clear

---

------------------
Gruß, Bernhard F.

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

---

Hallo Bernhard,

du kannst leider nicht abfragen ob ein Selectionset existiert.
Mit einer Fehlerbehandlung kannst du das aber lösen.

Code:

---

'---Selectionset anlegen
On Error Resume Next
Err.Clear
Set SelSet = ThisDrawing.SelectionSets.Add("WMF_EXPORT")
If Err.Number <> 0 Then
'---Falls vorhanden
  On Error GoTo 0
  Set SelSet = ThisDrawing.SelectionSets("WMF_EXPORT")
End If
On Error GoTo 0

---

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

---

also wenn es dir nur um die Namen in der aktuellen Zeichnung geht kannst du folgendes machen:

Sub test()

  Dim objacad As AutoCAD.AcadDocument
  Dim adBlock As AcadBlock
  Dim adBlockList As String

 
  Set objacad = AutoCAD.ActiveDocument

  For Each adBlock In objacad.Blocks

    adBlockList = adBlockList + vbCrLf + adBlock.Name

  Next adBlock
  MsgBox adBlockList

End Sub

Ausgabe ist hier wie bei deinem Bsp in der MsgBox.
Der Code ist so geschrieben, dass er unter Excel gestartet wird....
Nur der Verweiss auf AutoCAD Objekte muss gesetzt werden...
Gruss Dennis

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

---

Hallo Dennis,

das wars. Das hab ich gesucht.

Danke.

------------------
Gruß, Bernhard F.

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