用VBA怎么得到文字的一些属性

wzj23020723

在CAD图中有一些文字记录的是当前点的高程数字，我现在想提取所有的这些文字对象的信息保存到EXCEL中，请问怎样才能得到这些文字对象，然后怎样根据文字对象得到文字对象的属性（坐标X,Y,和文字内容），谢谢大家了！

yulijin608

Sub test()
    Dim selSet As AcadSelectionSet
    Dim txtObj As AcadText
    Dim entObj As AcadEntity
    Dim i As Integer
    Dim fType(0 To 0) As Integer
    Dim fData(0 To 0) As Variant
    Dim j As Integer
   
    For i = ThisDrawing.SelectionSets.Count - 1 To 0 Step -1
        If ThisDrawing.SelectionSets.Item(i).Name = "SS1" Then
            ThisDrawing.SelectionSets.Item(i).Delete
            Exit For
        End If
    Next i
   
    Dim xlApp As New Excel.Application
    Dim xlBook As New Excel.Workbook
    Dim xlSheet As New Excel.Worksheet
   
    fType(0) = 0: fData(0) = "TEXT"
    Set selSet = ThisDrawing.SelectionSets.Add("SS1")
    selSet.Select acSelectionSetAll, , , fType, fData
   
    Set xlBook = xlApp.Workbooks.Add()
    Set xlSheet = xlBook.ActiveSheet
    xlSheet.Cells(1, 1) = "X"
    xlSheet.Cells(1, 2) = "Y"
    xlSheet.Cells(1, 3) = "Z"
    j = 2
    For Each entObj In selSet
        Set txtObj = entObj
        xlSheet.Cells(j, 3) = txtObj.TextString         '高程
        xlSheet.Cells(j, 1) = txtObj.InsertionPoint(1)  'X坐标
        xlSheet.Cells(j, 2) = txtObj.InsertionPoint(0)  'Y坐标
        j = j + 1
    Next entObj
    xlBook.SaveAs "C:\xyz.xls"
    xlBook.Close
    Set xlBook = Nothing
    xlApp.Quit
    Set xlApp = Nothing
End Sub

wzj23020723

真的非常感谢你，非常好使！呵呵，送个鲜花。

其实小弟是这样个意思，我的这个图中有好多点，这个点的高程信息是写在他旁边的文字中的，有没有办法，把点旁边的文字内容读出来写到那个点的Z属性中啊？

我看了下，一般的点和标注文字的位置关系是定的。是不是在这个点周围一定范围中搜索文字，然后读取值写到这个点的Z属性中呢！

jsxygshh

做个标记，以待学习

njyulei

学习了

rensd

不就是cass7.0中的格式？

徐书远

学习学习

sscylh

学习了!!!               

xhk32067

学习了，谢谢yulijin608