中望CAD VBA 后台文字内容替换

Public Sub ReplaceTextInBackWithDbxTech()
    Dim filePath As String, fileName As String
    Dim dbx As New ZxDbDocument
    Dim dicts As New Dictionary, var As Variant
    dicts.Add "Drawing", "DRAWING"
    dicts.Add "OSS", "OSS 2"
    filePath = ThisDrawing.Path
    fileName = VBA.Dir(filePath & "\*.dwg")
    Dim startTime As Double
    startTime = Timer
    Do While fileName <> ""
        DoEvents
        If fileName <> ThisDrawing.Name Then
            dbx.Open filePath & "\" & fileName
            Dim ent As ZcadEntity
            For Each ent In dbx.Database.ModelSpace
                If TypeOf ent Is ZcadText Or TypeOf ent Is ZcadMText Then
                    For Each var In dicts
                        If ent.TextString Like "*" & var & "*" Then
                            ent.TextString = VBA.Replace(ent.TextString, var, dicts(var))
                            ent.color = zcCyan
                        End If
                    Next
                End If
            Next
            dbx.SaveAs filePath & "\" & fileName
        End If
        fileName = Dir
    Loop
    Set dbx = Nothing: Set dicts = Nothing
    MsgBox "代码执行用时: " & Timer - startTime & " 秒", vbInformation    ' 输出结果
End Sub