<学习笔记> VBA_Line list_01

1. 运行报错:"编译错误:用户定义类型未定义",如下图所示:

解决办法:(1) 在该界面的“工具”→“引用”界面选中cad的库文件;如果没有CAD的库文件,在“浏览”中选择C:\Program Files\Common Files\Autodesk Shared\acax19enu.tlb  (CAD_2014版,其他版本有待试验。)

(2)参考以下文章:

VBA-"找不到工程或库" 解决方案 

VBA-"找不到工程或库" 解决方案_宋哥的博客-CSDN博客_vba找不到工程或库

2. 完整代码:

Sub piping()
Dim CAD As AcadApplication, doc As AcadDocument, textstyle As AcadTextStyle
Dim ent As AcadEntity, Files As String, strfind(0 To 6) As String, m As Integer
Dim Str, DwgN As String
Files = "xxx" ' 输入路径
myfile = Dir(Files & "*.") '*:通配符
Set CAD = New AcadApplication
strfind(0) = "PR-"
strfind(1) = "PG-"
strfind(2) = "CWS-"
strfind(3) = "CWR-"
strfind(4) = "LN-"
strfind(5) = "HN-"
strfind(6) = "H-"

m = 1
Do Until myfile = ""
    cpath = Files & myfile
    DwgN = myfile
    On Error Resume Next
    Application.DisplayAlerts = False
    Set doc = CAD.Documents.Open(cpath)
    For i = 0 To 6
        For Each ent In doc.ModelSpace
            If TypeOf ent Is AcadText Or TypeOf ent Is AcadMText Then
                With ent
                    Str = .TextString
                    If InStr(Str, strfind(i)) > 0 Then
                    Sheet1.Cells(m, 1) = Str
                    Sheet1.Cells(m, 2) = DwgN
                    m = m + 1
                    End If
                End With
            End If
        Next ent
    Next i
    doc.Save
    doc.Close
    myfile = Dir
Loop
CAD.Application.Quit
End Sub

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值