（求救mccad）vb6可以调用ObjectDbx技术吗？
<p>求救</p><p></p><p>vb6可以调用ObjectDbx技术实现不打开图纸进行文字查找替换吗？</p><p> </p><p> 先谢了！</p> <p>这是源代码，希望mccad及高手修改下！！！</p><p></p><p></p><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><p></p> <p>ObjectDbx是在AutoCAD打开的基础上才能实现。请注意，它可以实现不打开图形而对图形进行操作，但需要打开AutoCAD。</p><p>如果在VB中，则可以打开AutoCAD并让AutoCAD隐藏起来的情况下进行操作。但这样的话，会有长时间停顿的问题，因为需要在后台打开AutoCAD。</p> <p>在VB中，可以实现不打开图形而对图形进行操作吗？</p>打开AutoCAD并让AutoCAD隐藏还是慢，可以像在ObjectDbx中那么快吗？ Google 搜索 OpenDwg lzh741206发表于2009-5-22 21:30:00static/image/common/back.gifGoogle 搜索 OpenDwg<p>大哥，这个好像绝迹了，有谁能提供一下吗？不胜感激！</p><p> <a href="mailto:ywwxmm@yeah.net">ywwxmm@yeah.net</a></p>
页:
[1]