【CAD】通过VBA获取CAD中的文本

同事需求，要提取单线图中的所有焊口编号和检测报告中的做比对。网上找了个有些麻烦，不能选取非文本，否则报错。于是修改代码如下。 

用法：

1、打开cad文件

2、在VB编辑器中复制以下代码，然后运行

3、此时回到CAD，选取要提取的文本，如果都需要提取，则全选。 选取非文本时脚本会自动跳过。右键完成。

4、结果保存在d:/output.txt文件内。

Sub AcadGetText()
    
    Dim sset As AcadSelectionSet   '声明定义选择集
    Dim ent As AcadEntity          '声明实体
    Dim fso, f
    Dim filename As String         '声明文件字符串
    Dim str As String
    
    filename = "d:/output.txt"
    
    Do While ThisDrawing.SelectionSets.Count > 0
        ThisDrawing.SelectionSets.Item(0).Delete
    Loop
    
    Set sset = ThisDrawing.SelectionSets.Add("sst")  '添加选择集
    sset.SelectOnScreen                              '在屏幕上选择对象
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set f = fso.OpenTextFile(filename, 8, True)
    
    ' 可能选取到非文本，所以。。。
    On Error Resume Next
    For Each ent In sset
        str = ""
        str = ent.TextString
        If str <> "" Then f.WriteLine str
    Next
    
    f.Close
    
End Sub

参考于：https://blog.csdn.net/maokaijiang/article/details/5814147

自己修改了些代码，用于处理选取了非文本时报错问题。也更换了写文件的方式。

--

2021.1.19 锦采