Code:
'Product: Macro replaces strings in Instance name / Part: Macro is searching for string and replaces itSub CATMain()
on error resume next
Set actProd = CATIA.ActiveDocument.Product
DName = CATIA.ActiveDocument.FullName
origstr = Inputbox ("Insert string to replace", "Search and Replace (old string)")
If origstr <> "" then
Fehler = 0
else
Fehler = 1
msgbox ("Please enter valid string and try again!")
Exit Sub
End If
newstr = Inputbox ("Insert new string", "Search and Replace (new string)")
If Fehler = 0 then
If InStr(DName, "CATProduct") Then
traverse actProd, origstr, newstr
else
If InStr(DName, "CATDrawing") Then
msgbox ("In Drawing Workbench only names in tree will be replaced!"&Chr(10)& "Text inside views can be replaced by edit --> replace!")
End If
SearchCatPart origstr, newstr
End If
End IF
End Sub
'*******************************************************************************************************
Sub traverse(Prod, origstr, newstr)
set refp = Prod.ReferenceProduct
if instr(refp.Name, origstr) then
newpname = Replace(refp.Name, origstr, newstr)
on error resume next
refp.Name = newpname
fehler=Err.Number
On Error Goto 0
If fehler <> 0 then
Box = MsgBox("file:" + Chr(10) + (refp.Name) + Chr(10) + "is causing the error!" + Chr(10) + "special characters in name?" + Chr(10) + "please correct first!", vbInformation, "error!!!")
Exit Sub
end if
end if
if instr(refp.PartNumber, origstr) then
newpnum = Replace(refp.PartNumber, origstr, newstr)
refp.PartNumber = newpnum
end if
Set prods = Prod.Products
pc = prods.Count
If pc > 0 then
For i = 1 to pc
traverse prods.Item(i), origstr, newstr
Next
End If
End Sub
'*******************************************************************************************************
Sub SearchCatPart(origstr, newstr)
Set activePart = CATIA.ActiveDocument
Set selection1 = activePart.Selection
selection1.Clear
selection1.Search "Name=*"&(origstr)&"*,all"
For n=1 to selection1.count
set selection2 = selection1.Item(n).value
selection2.name = replace(selection2.name, origstr, newstr)
Next
selection1.Clear
End Sub
'*******************************************************************************************************
Sub SearchCatDrawing(origstr, newstr)
Set activePart = CATIA.ActiveDocument
Set selection1 = activePart.Selection
selection1.Clear
selection1.Search "CATDrwSearch.DrwText.TextString='"&origstr&"',all"
For n=1 to selection1.count
set selection2 = selection1.Item(n).value.text
selection2 = replace(selection2, origstr, newstr)
Next
selection1.Clear
End Sub
Foren auf CAD.de (alle Foren)
| 
