#2
yuma2023-04-03 19:06
这段代码中的错误可能是由于以下原因导致的:
缺少对AutoCAD的引用:在VB中使用AutoCAD对象需要先添加对AutoCAD的引用。可以在VB的“工具”菜单中选择“引用”,然后勾选AutoCAD的相关选项。 选择集中没有文字对象:如果CAD文件中没有文字对象,那么选择集中就不会有任何对象。在这种情况下,遍历选择集时会出现错误。 选择集中包含非文字对象:如果选择集中包含非文字对象,那么遍历选择集时会出现错误。可以在选择对象时指定对象类型,例如:selSet.Select acSelectionSetAll, , , Array("", "", "", "AcDbText")。 oldText或newText为空:如果oldText或newText为空,那么在替换文字时会出现错误。可以在替换文字之前先检查oldText和newText是否为空。 下面是一份修改后的代码,可以尝试运行一下: Sub ReplaceTextInCAD() Dim folderPath As String folderPath = "C:\CAD Files\" 'CAD文件所在的文件夹路径 Dim oldText As String oldText = "Old Text" '需要替换的文字 Dim newText As String newText = "New Text" '替换后的文字 Dim counter As Integer counter = 0 '计数器,记录替换的文字数量 Dim fileName As String fileName = Dir(folderPath & "*.dwg") '获取文件夹中的DWG文件 Do While fileName <> "" ' 打开CAD文件 Dim acadDoc As AcadDocument Set acadDoc = ThisDrawing.Application.Documents.Open(folderPath & fileName) ' 选择所有文字对象 Dim selSet As AcadSelectionSet Set selSet = acadDoc.SelectionSets.Add("MySelectionSet") selSet.Select acSelectionSetAll, , , Array("", "", "", "AcDbText") ' 遍历选中的文字对象 Dim objText As AcadText For Each objText In selSet ' 如果找到指定的文字 If InStr(1, objText.TextString, oldText, vbTextCompare) > 0 Then ' 替换文字 objText.TextString = Replace(objText.TextString, oldText, newText, , , vbTextCompare) ' 增加计数器 counter = counter + 1 End If Next ' 清除选择集 selSet.Delete ' 保存并关闭CAD文件 acadDoc.Save acadDoc.Close ' 进入下一个DWG文件 fileName = Dir() Loop ' 显示替换的文字数量 MsgBox "共替换了 " & counter & " 个文字。" End Sub 注意,这段代码仅能替换DWG文件中的文字,不能替换DWT、DWS等文件中的文字。如果需要替换其他类型的CAD文件中的文字,还需要进行相应的修改。 |
下面是我自己查的一段代码,但总是运行出错。
Do While fileName <> ""
' 打开CAD文件
Dim acadDoc As AcadDocument
Set acadDoc = Application.Documents.Open(folderPath & fileName) 'ThisDrawing.Application.Documents.Open(folderPath & fileName)
' 选择所有文字对象
Dim selSet As AcadSelectionSet
Set selSet = acadDoc.SelectionSets.Add("MySelectionSet")
selSet.Select acSelectionSetAll, , , Array("", "", "", "*Text")''''运行到这里总是出错。运行到这里总是出错。运行到这里总是出错。
' 遍历选中的文字对象
Dim objText As AcadText
For Each objText In selSet
' 如果找到指定的文字
If InStr(1, objText.TextString, oldText, vbTextCompare) > 0 Then
' 替换文字
objText.TextString = Replace(objText.TextString, oldText, newText, , , vbTextCompare)
' 增加计数器
counter = counter + 1
End If
Next
' 清除选择集
selSet.Delete
' 保存并关闭CAD文件
acadDoc.Save
acadDoc.Close
' 进入下一个DWG文件
fileName = Dir()
Loop