VB6.0使用ObjectDBX实现批量文字替换，帮忙修改一下
<p>Option Explicit</p><p>Dim objDBX As Object </p><p>Private Sub Form_Activate()<br/>If Left(Version, 2) = "15" Then<br/> Set objDBX = CreateObject("ObjectDBX.AxDbDocument.1")<br/>End If<br/>End Sub</p><p>Private Sub Command1_Click()<br/><br/>If ListView1.ListItems.Count = 0 Then<br/> MsgBox "请先选择图纸！"<br/> Exit Sub<br/> <br/>Else<br/> Dim adText As AcadText<br/> Dim adMText As AcadMText<br/> Dim adSS As AcadSelectionSet<br/> Dim fType(0 To 1) As Integer, fData(0 To 1)<br/> Dim i As Integer</p><p> If txtfind.Text = "" Or txtreplace.Text = "" Then<br/> MsgBox "输入所要替换的字符串内容！"<br/> Exit Sub<br/> End If<br/><br/> Dim strFind As String<br/> Dim strReplace As String<br/> strFind = txtfind.Text<br/> strReplace = txtreplace.Text</p><p> ' 打开图形进行操作<br/>For i = 1 To Form1.ListView1.ListItems.Count + 1<br/>Call ReplaceTextInDwg(Form1.ListView1.ListItems(i).SubItems(1) & "\" & ListView1.ListItems.Item(i), strFind,strReplace)<br/> Next i<br/>End If<br/> MsgBox "OK! ^_^"<br/>End Sub</p><p>' 对某个图形进行文字替换<br/>Private Sub ReplaceTextInDwg(ByVal strDwgName As String, ByVal strFind As String, _<br/> ByVal strReplace As String)<br/> ' 打开指定的图形<br/>objDBX.Open strDwgName</p><p> Dim ent As AcadEntity<br/> For Each ent In objDBX.ModelSpace<br/> If TypeOf ent Is AcadText Or TypeOf ent Is AcadMText Then<br/> With ent<br/> If InStr(.TextString, strFind) Then .TextString = ReplaceStr(.TextString, strFind, strReplace, False)<br/> End With<br/> End If<br/> Next ent<br/> <br/> objDBX.SaveAs strDwgName<br/>End Sub</p><p>' 对字符串中指定的字符进行替换<br/>Public Function ReplaceStr(ByVal searchStr As String, ByVal oldStr As String, _<br/> ByVal newStr As String, ByVal firstOnly As Boolean) As String<br/> '对错误操作的处理<br/> If searchStr = "" Then Exit Function<br/> If oldStr = "" Then Exit Function</p><p> ReplaceStr = ""<br/> Dim i As Integer, oldStrLen As Integer, holdStr As String, StrLoc As Integer<br/> <br/> '计算原来字符串的长度<br/> oldStrLen = Len(oldStr)<br/> StrLoc = InStr(searchStr, oldStr)<br/> <br/> While StrLoc > 0<br/> '获得图形中文字对象位于查找字符串之前的字符串<br/> holdStr = holdStr & Left(searchStr, StrLoc - 1) & newStr<br/> '获得文字对象位于查找字符串之后的字符串<br/> searchStr = Mid(searchStr, StrLoc + oldStrLen)<br/> StrLoc = InStr(searchStr, oldStr)<br/> If firstOnly Then ReplaceStr = holdStr & searchStr: Exit Function<br/> Wend<br/> <br/> ReplaceStr = holdStr & searchStr<br/>End Function</p><p></p><p>' 列表框中是否存在指定名称的项目<br/>Private Function HasItem(ByVal strDwgName As String) As Boolean<br/> HasItem = False<br/> <br/> Dim i As Integer<br/> For i = 1 To Form1.ListView1.ListItems.Count + 1<br/> If StrComp(Form1.ListView1.ListItems(i).SubItems(1) & "\" & ListView1.ListItems.Item(i), strDwgName, vbTextCompare) = 0 Then<br/> HasItem = True<br/> Exit Function<br/> End If<br/> Next i<br/>End Function</p><p></p><p></p>
页:
[1]