（求救mccad）vb6可以调用ObjectDbx技术吗？

king-hack

求救

vb6可以调用ObjectDbx技术实现不打开图纸进行文字查找替换吗？

          

               先谢了！

king-hack

这是源代码，希望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

mccad

ObjectDbx是在AutoCAD打开的基础上才能实现。请注意，它可以实现不打开图形而对图形进行操作，但需要打开AutoCAD。

如果在VB中，则可以打开AutoCAD并让AutoCAD隐藏起来的情况下进行操作。但这样的话，会有长时间停顿的问题，因为需要在后台打开AutoCAD。

king-hack

在VB中，可以实现不打开图形而对图形进行操作吗？

打开AutoCAD并让AutoCAD隐藏还是慢，可以像在ObjectDbx中那么快吗？

雪山飞狐_lzh

Google 搜索 OpenDwg

king-hack

lzh741206发表于2009-5-22 21:30:00Google 搜索 OpenDwg

大哥，这个好像绝迹了，有谁能提供一下吗？不胜感激！

        ywwxmm@yeah.net