替换CAD多行文本的宏程序

Substitute_Mtext()

Dim objMText As AcadMText

Dim strFind As String

Dim strReplace As String

strFind = InputBox("Enter the text to be replaced:")

strReplace = InputBox("Enter the replacement text:")

For Each objMText In ThisDrawing.ModelSpace

If objMText.TextString = strFind Then

objMText.TextString = strReplace

End If

Next

End Sub

相关问题

比例替换CAD文件多行文本的宏程序

Sub ReplaceText()
'宏程序名称：ReplaceText
'功能：批量替换CAD文件中的多行文本
'Dimensions:
Dim sFileName As String '文件名
Dim sFilePath As String '文件路径
Dim sTextToReplace As String '要替换的文本
Dim sReplaceWith As String '替换后的文本
Dim oAcadApp As AcadApplication 'CAD应用程序
Dim oAcadDoc As AcadDocument 'CAD文档
Dim oMText As AcadMText '多行文本对象
Dim iCount As Integer '计数器
'Input Dialog:
sTextToReplace = InputBox("请输入要替换的文本：", "替换文本")
sReplaceWith = InputBox("请输入替换后的文本：", "替换后文本")
'Error Checking:
If sTextToReplace = "" Or sReplaceWith = "" Then
MsgBox "请输入要替换的文本和替换后的文本。"
Exit Sub
End If
'Get File Name and Path:
sFileName = Application.GetOpenFilename("CAD文件 (*.dwg), *.dwg", , "选择要替换文本的文件：")
If sFileName = "False" Then Exit Sub '用户取消操作
sFilePath = Left(sFileName, InStrRev(sFileName, "\"))
'Open CAD Document:
Set oAcadApp = GetObject(, "AutoCAD.Application") '获取CAD应用程序
oAcadApp.Visible = True '显示CAD应用程序
Set oAcadDoc = oAcadApp.Documents.Open(sFileName) '打开CAD文档
'Loop Through MText Objects:
For Each oMText In oAcadDoc.MTexts
If InStr(1, oMText.TextString, sTextToReplace, vbTextCompare) > 0 Then '找到要替换的文本
oMText.TextString = Replace(oMText.TextString, sTextToReplace, sReplaceWith, , , vbTextCompare) '替换文本
iCount = iCount + 1 '计数器加一
End If
Next oMText
'Close CAD Document:
oAcadDoc.Save '保存CAD文档
oAcadDoc.Close '关闭CAD文档
oAcadApp.Quit '退出CAD应用程序
'Summary Message:
If iCount = 0 Then
MsgBox "未找到要替换的文本。"
Else
MsgBox "替换完成，共替换了 " & iCount & " 个文本。"
End If
End Sub