|
|
发表于 2009-5-22 21:00:00
|
显示全部楼层
这是源代码，希望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
|
|
置顶卡
