（求救mccad）vb6可以调用ObjectDbx技术吗？
求救vb6可以调用ObjectDbx技术实现不打开图纸进行文字查找替换吗？
先谢了！
这是源代码，希望mccad及高手修改下！！！
Option Explicit
Dim objDBX As Object
Private Sub Form_Activate()
If Left(Version, 2) = "15" Then
Set objDBX = CreateObject("ObjectDBX.AxDbDocument.1")
End If
End Sub
Private Sub Command1_Click()
If ListView1.ListItems.Count = 0 Then
MsgBox "请先选择图纸！"
Exit Sub
Else
Dim adText As AcadText
Dim adMText As AcadMText
Dim adSS As AcadSelectionSet
Dim fType(0 To 1) As Integer, fData(0 To 1)
Dim i As Integer
If txtfind.Text = "" Or txtreplace.Text = "" Then
MsgBox "输入所要替换的字符串内容！"
Exit Sub
End If
Dim strFind As String
Dim strReplace As String
strFind = txtfind.Text
strReplace = txtreplace.Text
' 打开图形进行操作
For i = 1 To Form1.ListView1.ListItems.Count + 1
Call ReplaceTextInDwg(Form1.ListView1.ListItems(i).SubItems(1) & "\" & ListView1.ListItems.Item(i), strFind,strReplace)
Next i
End If
MsgBox "OK!^_^"
End Sub
' 对某个图形进行文字替换
Private Sub ReplaceTextInDwg(ByVal strDwgName As String, ByVal strFind As String, _
ByVal strReplace As String)
' 打开指定的图形
objDBX.Open strDwgName
Dim ent As AcadEntity
For Each ent In objDBX.ModelSpace
If TypeOf ent Is AcadText Or TypeOf ent Is AcadMText Then
With ent
If InStr(.TextString, strFind) Then .TextString = ReplaceStr(.TextString, strFind, strReplace, False)
End With
End If
Next ent
objDBX.SaveAs strDwgName
End Sub
' 对字符串中指定的字符进行替换
Public Function ReplaceStr(ByVal searchStr As String, ByVal oldStr As String, _
ByVal newStr As String, ByVal firstOnly As Boolean) As String
'对错误操作的处理
If searchStr = "" Then Exit Function
If oldStr = "" Then Exit Function
ReplaceStr = ""
Dim i As Integer, oldStrLen As Integer, holdStr As String, StrLoc As Integer
'计算原来字符串的长度
oldStrLen = Len(oldStr)
StrLoc = InStr(searchStr, oldStr)
While StrLoc > 0
'获得图形中文字对象位于查找字符串之前的字符串
holdStr = holdStr & Left(searchStr, StrLoc - 1) & newStr
'获得文字对象位于查找字符串之后的字符串
searchStr = Mid(searchStr, StrLoc + oldStrLen)
StrLoc = InStr(searchStr, oldStr)
If firstOnly Then ReplaceStr = holdStr & searchStr: Exit Function
Wend
ReplaceStr = holdStr & searchStr
End Function
' 列表框中是否存在指定名称的项目
Private Function HasItem(ByVal strDwgName As String) As Boolean
HasItem = False
Dim i As Integer
For i = 1 To Form1.ListView1.ListItems.Count + 1
If StrComp(Form1.ListView1.ListItems(i).SubItems(1) & "\" & ListView1.ListItems.Item(i), strDwgName, vbTextCompare) = 0 Then
HasItem = True
Exit Function
End If
Next i
End Function
ObjectDbx是在AutoCAD打开的基础上才能实现。请注意，它可以实现不打开图形而对图形进行操作，但需要打开AutoCAD。
如果在VB中，则可以打开AutoCAD并让AutoCAD隐藏起来的情况下进行操作。但这样的话，会有长时间停顿的问题，因为需要在后台打开AutoCAD。
在VB中，可以实现不打开图形而对图形进行操作吗？
打开AutoCAD并让AutoCAD隐藏还是慢，可以像在ObjectDbx中那么快吗？ Google 搜索 OpenDwg
大哥，这个好像绝迹了，有谁能提供一下吗？不胜感激！
ywwxmm@yeah.net
页:
[1]