jsxygshh 发表于 2012-10-10 07:35:44

vb如何提取“块参考”属性中的“A”对应值到EXCEL

请各位高手不吝赐教：
如何用VB提取“块参考”属性中的“A”对应值到EXCEL，先谢谢了！


woaishuijia 发表于 2012-10-10 12:07:40

    Dim myAcadApp As AutoCAD.AcadApplication, SS As AcadSelectionSet, FT(0) As Integer, FD(0) As Variant
    Dim BF As AcadBlockReference, AF As AcadAttributeReference, V1 As Variant, V2 As Variant
    On Error Resume Next
    Set myAcadApp = GetObject(, "Autocad.Application")
    If Err <> 0 Then
      Err.Clear
      Set myAcadApp = CreateObject("Autocad.Application")
      If Err Then
            MsgBox Err.Number & ":" & Err.Description
            Exit Sub
      End If
    End If
    With myAcadApp
      .WindowState = acMax
      .Visible = True
      AppActivate "AUTOCAD"
      With .ActiveDocument
            Set SS = .SelectionSets.Add("SS")
            FT(0) = 0
            FD(0) = "INSERT"
            SS.SelectOnScreen FT, FD
            For Each BF In SS
                V1 = BF.GetAttributes
                For Each V2 In V1
                  Set AF = V2
                  If AF.TagString = "A" Then
                        '此处把 AF.TextString 属性填入EXCEL单元格
                  End If
                Next
            Next
            SS.Delete
      End With
    End With

jsxygshh 发表于 2012-10-10 07:37:44

补充一下：一次可以选一个或多个块，分别输出到EXCEL

mikewolf2k 发表于 2012-10-10 08:19:01

大体分两步吧。1.读取块属性。2输出文本到excel。楼主可搜寻这两方面的帖子学习。祝顺利。

jsxygshh 发表于 2012-10-10 08:53:09

mikewolf2k 发表于 2012-10-10 08:19 static/image/common/back.gif
大体分两步吧。1.读取块属性。2输出文本到excel。楼主可搜寻这两方面的帖子学习。祝顺利。

第一步纠结两天了都没有成功，请帮助解决一下，十分感谢

sscylh 发表于 2012-10-10 12:10:32

Sub aa()
Dim bobj As AcadBlockReference
Dim a
Dim arr()
Dim ss As AcadSelectionSet
Dim filtertype(0 To 0) As Integer
Dim filterdata(0 To 0) As Variant
Dim xls As Excel.Application
Set xls = New Excel.Application
Set ss = ThisDrawing.SelectionSets.Add(CStr(Rnd))
filtertype(0) = 0
filterdata(0) = "insert"
ss.SelectOnScreen filtertype, filterdata
For Each bobj In ss
i = i + 1
ReDim Preserve arr(1 To i)
a = bobj.GetAttributes
arr(i) = a(0).TextString
Next
With xls.Workbooks.Add
   .Sheets(1)..Resize(i, 1) = xls.Transpose(arr)
   .SaveAs "d:/123.xls"
   .Close
End With
xls.Quit
End Sub

jsxygshh 发表于 2012-12-8 01:14:58

谢谢二位老师的指点，调试成功了，谢谢！

云牧帆 发表于 2013-1-23 15:05:36

sscylh 发表于 2012-10-10 12:10 static/image/common/back.gif


斑竹跨界高手

陈亚娣 发表于 2013-3-28 23:40:28

顶一下!!!!!!

jyzas 发表于 2013-8-15 20:30:48

支持
页: [1] 2
查看完整版本: vb如何提取“块参考”属性中的“A”对应值到EXCEL