Code:
Sub CATMain()'######################################### Eingabe #####################################################
CATIA.DisplayFileAlerts = False 'Fehlermeldungen ausschalten'
'CATIA.DisplayFileAlerts = true 'Fehlermeldungen einschalten'
sInputFile = CATIA.FileSelectionBox("Product auswählen und ab geht⤙s!", "*.CATProduct", CatFileSelectionModeOpen)
origstr = Inputbox ("Eingeben welcher Name oder Nummer ersetzt werden soll!!! ", "Suche und Ersetze (Suche)")
newstr = Inputbox ("Zu ersetzenden Namen oder Nummer eingeben", "Suche und Ersetze (Ersetze)")
Dim Shell As Object
Dim Ordner As String
Set Shell = CreateObject("Shell.Application")
EingabeSP = Shell.BrowseForFolder(0, "Bitte geben Sie Speicherort ein. Jetzt mach hin ich warte! ", 0).Self.Path
Strich = "\"
'#######################################################################################################
'############################################ Product Oeffnen #########################################
Set oDoc = CATIA.Documents.Open(sInputFile)
'#######################################################################################################
Set actProd = CATIA.ActiveDocument.Product
traverse actProd, origstr, newstr
End Sub
'################################################ Partnumber Umbenennen ###############################
Sub traverse(Prod, origstr, newstr)
set refp = Prod.ReferenceProduct
if instr(refp.Name, origstr) then
newpname = Replace(refp.Name, origstr, newstr)
refp.Name = newpname
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
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Set oMainProduct = CATIA.ActiveDocument.product
Dim oMainProducts As Products
Set oMainproducts = oMainProduct.Products
Umbenennen oMainProducts
End Sub
'#######################################################################################################
'########################### Exemplarnamen Umbenennen #################################################
Sub Umbenennen(oProducts As Products)
Dim oPartName As String
Dim oName As String
Dim i As Long
For x = 1 to oProducts.Count
Set oInstance = oProducts.Item(x)
oNumber = oInstance.PartNumber
oName = oInstance.Name
i=0
Do
On Error Resume Next
i = i+1
If i>5000 Then ' Zahl soll angepasst werden
Exit Do
End If
oInstance.Name = oNumber & "." & i
If Err.Number = 0 Then
Umbenennen oProducts.Item(x).ReferenceProduct.Products
Exit Do
ElseIf Err.Number = -2147467259 Then
Err.Clear
Err.Number = 0
Else
Exit Do
End If
Loop
If oInstance.Products.Count > 0 Then
Umbenennen oInstance.Products
End If
Next
'Msgbox "TEST"
Speicher
End Sub
'#######################################################################################################
'##################################################### Speichern von Part/Product ####################
Sub Speicher ()
'Dim oSel as Selection
'Set oSel = CATIA.ActiveDocument.Selection
'oSel.Clear
'_____________Abfrage Selektierte Elemente_____________________________________________
'Dim UserSelektion As Selection
' Set UserSelektion = productDocument1.Selection
Dim UserSelektion As Selection
Set productDocument1 = CATIA.ActiveDocument
Set UserSelektion = productDocument1.Selection
UserSelektion.Search "(CATAsmSearch.Part+(CATAsmSearch.Product)),all"
'Dim UserSelektion As Selection
'Set UserSelektion = CATIA.ActiveDocument.Selection
'If UserSelektion.Count > 0 Then
For I = 1 to UserSelektion.Count
'MsgBox(UserSelektion.Item(I).Value.Name)
Name = (UserSelektion.Item(I).Value.ReferenceProduct.Name) 'Name = (UserSelektion.Item(I).Value.Name) 'product1.PartNumber
'__________________________________________________________________________________
'_____________Zuordnung____________________________________________________________
VAR_pfad = EingabeSP
Set productDocument1 = CATIA.ActiveDocument
Datei = VAR_pfad & Strich & Name
'__________________________________________________________________________________
'_____________Abfrage Selektierte Elemente zum Speichen_________________________________
Dim SelectedProduct As Product
Set SelectedProduct = CATIA.ActiveDocument.Selection.Item2(I).Value
Dim doc As Document
Set doc = SelectedProduct.ReferenceProduct.Parent
'__________________________________________________________________________________
'_____________Speicher Befehl Selektierte Elemente ______________________________________
CATIA.DisplayFileAlerts = False '= true
doc.SaveAs Datei
Next
End Sub
'######################################################################################################