示例：在 Excel 电子表格 （VBA/ActiveX） 上列出 AutoCAD 属性

此示例子例程查找当前图形中的所有块参照。

然后，它会查找附加到这些块引用的属性，并在 Excel 电子表格中列出它们。若要运行此示例，请执行以下操作：

1. 打开包含带属性的块参照的图形。（示例图形 sample/activeX/attrib.dwg 包含此类块参照。
2. 在AutoCAD命令提示下，输入VBAIDE，然后按Enter键。

   将显示 VBA IDE。

3. 在 VBA IDE 的菜单栏上，单击“工具”菜单 “References”。
4. 在“引用”对话框中，选择“Microsoft Excel <version_number>对象模型”。单击“确定”。
5. 将以下子例程复制到 VBA 代码窗口中并运行它。

   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