示例：列出 Excel 电子表格上的 AutoCAD 特性 （VBA/ActiveX）
此示例子例程查找当前图形中的所有块参照。
然后，它会查找附加到这些块引用的属性，并在 Excel 电子表格中列出它们。若要运行此示例，请执行以下操作：
- 打开包含带属性的块参照的图形。（示例图形 sample/activeX/attrib.dwg 包含此类块参照。
- 在AutoCAD命令提示下，输入VBAIDE，然后按Enter键。
将显示 VBA IDE。
- 在 VBA IDE 的菜单栏上，单击“工具”菜单
 “References”。
- 在“引用”对话框中，选择“Microsoft Excel <version_number>对象模型”。单击“确定”。
- 将以下子例程复制到 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
| 
|Archiver|CAD开发者社区
( 苏ICP备2022047690号-1 苏公网安备32011402011833)
