Example: List AutoCAD attributes on an Excel spreadsheet (VBA/ActiveX)

This example subroutine finds all the block references in the current drawing.

It then finds the attributes attached to those block references and lists them in an Excel spreadsheet. To run this example, do the following:

1. Open a drawing containing block references with attributes. (The sample drawing sample/activeX/attrib.dwg contains such block references.)
2. At the AutoCAD Command prompt, enter VBAIDE and press Enter.

   The VBA IDE is displayed.

3. In the VBA IDE, on the menu bar, click the Tools menu References.
4. In the References dialog box, select Microsoft Excel <version_number> Object Model. Click OK.
5. Copy the following subroutine into a VBA Code window and run it.

   Sub ExtractAtts()
     Dim Excel As Excel.Application
     Dim ExcelSheet As Object
     Dim ExcelWorkbook As Object
   
     Dim RowNum As Integer
     Dim Header As Boolean
     Dim elem As AcadEntity
     Dim Array1 As Variant
     Dim Count As Integer
   
     ' Launch Excel.
     Set Excel = New Excel.Application
   
     ' Create a new workbook and find the active sheet.
     Set ExcelWorkbook = Excel.Workbooks.Add
     Set ExcelSheet = Excel.ActiveSheet
     ExcelWorkbook.SaveAs "Attribute.xls"
   
     RowNum = 1
     Header = False
   
     ' Iterate through model space finding
     ' all block references.
     For Each elem In ThisDrawing.ModelSpace
       With elem
         ' When a block reference has been found,
         ' check it for attributes
         If StrComp(.EntityName, "AcDbBlockReference", 1) = 0 Then
           If .HasAttributes Then
             ' Get the attributes
             Array1 = .GetAttributes
   
             ' Copy the Tagstrings for the
             ' Attributes into Excel
             For Count = LBound(Array1) To UBound(Array1)
               If Header = False Then
                 If StrComp(Array1(Count).EntityName, "AcDbAttribute", 1) = 0 Then
                   ExcelSheet.Cells(RowNum, Count + 1).value = Array1(Count).TagString
                 End If
               End If
             Next Count
   
             RowNum = RowNum + 1
             For Count = LBound(Array1) To UBound(Array1)
               ExcelSheet.Cells(RowNum, Count + 1).value = Array1(Count).textString
             Next Count
   
             Header = True
           End If
         End If
       End With
     Next elem
     Excel.Application.Quit
   End Sub