Hi all,
I'm trying to buld a macro to iterate through many files and change a typo (we are working for a canadian client and some of my colleagues are not so good with english, they wrote "LENGHT" in a table).
I'm using AxDBlib with Autocad2010, and here's the code (something that I have adapded from an excel macro found on this forum):
Code:
Sub FixTypo()
Dim FileSystem As Object
Dim folderpath As String
Dim SubFolder
Dim SubSubFolder
Dim currentPour As String
Dim modelfile As String
Dim AcadDbx As AxDbDocument
Dim AcadObj As AcadObject
Dim AcadTxt As AcadText
folderpath = "D:\temp\"
Set FileSystem = CreateObject("Scripting.FileSystemObject")
Set AcadDbx = Application.GetInterfaceObject("ObjectDBX.AxDbDocument.18")
For Each SubFolder In FileSystem.GetFolder(folderpath).SubFolders
If SubFolder.Name <> "Xref" And SubFolder.Name <> "Xstamps" And SubFolder.Name <> "Publish" And SubFolder.Name <> "@ Superseded" And SubFolder.Name <> "0000_CM" And SubFolder.Name <> "1111_AR" Then
For Each SubSubFolder In SubFolder.SubFolders
currentPour = SubSubFolder.Name
modelfile = SubSubFolder.Path & "\" & "MDL_A-" & currentPour & "-CV-D50-001.dwg"
If Dir(modelfile) <> "" Then
AcadDbx.Open (modelfile)
If Err.Number = 0 And AcadDbx.Name <> "" Then
For Each AcadObj In AcadDbx.ModelSpace
If TypeOf AcadObj Is AcadText Then
Set AcadTxt = AcadObj
If InStr(AcadTxt.TextString, "LENGHT") <> 0 Then
AcadTxt.TextString = Replace(AcadTxt.TextString, "LENGHT", "LENGTH")
AcadDbx.Save
Exit For
End If
End If
Next AcadObj
Set AcadObj = Nothing
Set AcadTxt = Nothing
End If
End If
Next SubSubFolder
End If
Next SubFolder
Set AcadDbx = Nothing
End Sub
(the subfolder and subsubfolder thing is because of our storage system)
When I run it it stops at "AcadDbx.Save" throwing thew error
Code:
Method "Viewports" of object "IAxDbDocument" failed when saving via AxDBlib
I can't understand why.
Does anyone have a clue?