[求助]：CAD属性块中的文字提取

lh869

求助各位大侠，本人现在遇到一个十分棘手的问题，想请各位帮帮忙！

怎样才能用VB将我这CAD属性块中的文字提取出来，然后写入记事本或EXCEL中呢？？急！急！！急！！！（注：属性块的名称为 "MATBODY"）

小弟在此先谢过了！

yunzhong80

使用GetAttributes方法

lh869

能说得具体一点吗？最好举个例子！在此先谢了！！

yunzhong80

以下子例程在当前图形中查找所有的块引用，然后查找附着到这些块引用的属性，并将它们列在 Excel 电子表格中。要运行本样例，请按以下步骤执行：

打开包含块引用的图形，这些块引用带有属性。（样例图形 sample/activeX/attrib.dwg 包含这样的块引用。）
使用 AutoCAD VBAIDE 命令打开 VBA IDE。
使用 VBA IDE 中的“工具”“引用”菜单选项，选择 Microsoft Excel 8.0 对象模型。
将这个子例程复制到 VBA 的“代码”窗口中并运行它。
Sub Ch12_Extract()
    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
   
    ' 启动 Excel。
    Set Excel = New Excel.Application
   
    ' 创建新的工作簿并查找活动电子表格。
    Set ExcelWorkbook = Excel.Workbooks.Add
    Set ExcelSheet = Excel.ActiveSheet
    ExcelWorkbook.SaveAs "Attribute.xls"
   
    RowNum = 1
    Header = False
    ' 遍历模型空间，查找
    ' 所有的块引用。
    For Each elem In ThisDrawing.ModelSpace
        With elem
            ' 找到块引用时，
            ' 检查其属性
            If StrComp(.EntityName, "AcDbBlockReference", 1) _
                = 0 Then
                If .HasAttributes Then
                    ' 获取属性
                    Array1 = .GetAttributes
                    ' 将属性的标记字符串
                    ' 复制到 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

lh869

以上代码放到VB中能实现吗？是否还要有什么修改啊？

yunzhong80

好象只需要T修改hisDrawing.ModelSpace 和 Dim Array1 As Variant

你用VB写的吗？你知道在VB中SelectOnScreen方法的 [FilterType][, FilterData]  怎么定义和组码的吗？

lh869

我是用VB写的，但我还是菜鸟，刚接触VB不久，不知道在VB中SelectOnScreen方法的 [FilterType][, FilterData] 怎么定义和组码
希望指教以一下！！！thanks!!!

yunzhong80

我也不知道，我把VBA中的转换过去去行，可能转换错了

lh869

能留个QQ和EMAIL吗？？向高手请教！！！

yunzhong80

你如果解决了就发EMAIL给我吧，yunzhong80@vip.sina.com

lh869

我还有问题向您求助，一给你发了邮件，问题写在里面，请查收！
在此先谢谢了！！

WZY5357

很好，感谢