rename problem
rename problem
(OP)
I create a macro,the object is to:
1)rename the part name and instance name,
2) the instance name same to part name suffix ,for example, the part number is xxxx-001, the instance should be 001, if there are sevral xxx-001, the instance name should be 001, 001.1 001.2 etc.
3)save the renamed part to a specified path specified by inputbox,
4)save the filename same as renamed number.(macro see attachment).
now the macro have some problems:
1)the firt part (xxxx-001) filename is different,maybe xxxx-003,
2)specified path failed
3)when a part more than 1 piece, the instance name wound different to partnumber, ie, the partnumber xxxx-001, the instance number maybe 008.1 etc.
any help would be appriciated.
''''''''''''''''''''''''''
Language = "VBScript"
Sub CATMain()
CATIA.DisplayFileAlerts = False
new_str = inputbox("Enter the prefix:")
new_path = inputbox("Save to new path:")
str_len = len(new_str)
Set prod_Doc = CATIA.ActiveDocument
Set prod = prod_Doc.Product
Set prods = prod.Products
j = 1
k =1
For i = 1 To prods.Count
if left(prods.Item(i).PartNumber,str_len)<>new_str then
if j <10 then
prods.Item(i).PartNumber = new_str&"-00"&(j)
prods.Item(i).name = "00"&(j)
else
prods.Item(i).PartNumber = new_str&"-0"&(j)
prods.Item(i).name = "0"&(j)
end if
j = j + 1
else
prods.Item(i).name = "00"&(j)&"."&(k)
k = k + 1
end if
newName = prods.Item(j).PartNumber
Set docs = CATIA.Documents
set doc1 = docs.Item(j)
doc1.SaveAs new_path & NewName & ".CATPart"
Next
End Sub
1)rename the part name and instance name,
2) the instance name same to part name suffix ,for example, the part number is xxxx-001, the instance should be 001, if there are sevral xxx-001, the instance name should be 001, 001.1 001.2 etc.
3)save the renamed part to a specified path specified by inputbox,
4)save the filename same as renamed number.(macro see attachment).
now the macro have some problems:
1)the firt part (xxxx-001) filename is different,maybe xxxx-003,
2)specified path failed
3)when a part more than 1 piece, the instance name wound different to partnumber, ie, the partnumber xxxx-001, the instance number maybe 008.1 etc.
any help would be appriciated.
''''''''''''''''''''''''''
Language = "VBScript"
Sub CATMain()
CATIA.DisplayFileAlerts = False
new_str = inputbox("Enter the prefix:")
new_path = inputbox("Save to new path:")
str_len = len(new_str)
Set prod_Doc = CATIA.ActiveDocument
Set prod = prod_Doc.Product
Set prods = prod.Products
j = 1
k =1
For i = 1 To prods.Count
if left(prods.Item(i).PartNumber,str_len)<>new_str then
if j <10 then
prods.Item(i).PartNumber = new_str&"-00"&(j)
prods.Item(i).name = "00"&(j)
else
prods.Item(i).PartNumber = new_str&"-0"&(j)
prods.Item(i).name = "0"&(j)
end if
j = j + 1
else
prods.Item(i).name = "00"&(j)&"."&(k)
k = k + 1
end if
newName = prods.Item(j).PartNumber
Set docs = CATIA.Documents
set doc1 = docs.Item(j)
doc1.SaveAs new_path & NewName & ".CATPart"
Next
End Sub





RE: rename problem
Regards
Fernando
https://picasaweb.google.com/102257836106335725208 - Romania
https://picasaweb.google.com/103462806772634246699... - EU
RE: rename problem
1)I expect to rename and save selested parts, but it save all parts,
2)It save twice,I don't know why
3)sometimes, some error occur when running,
follow is my code(CATScript)
Language = "VBScript"
Sub CATMain()
'''''''''''''''''''''rename partnamber
if CATIA.Documents.Count = 0 Then
'MsgBox "CATIA未打开,请先打开CATIA", ,msgboxtext
MsgBox "open CATIA first", ,msgboxtext
Exit Sub
End If
If InStr(CATIA.ActiveDocument.Name, ".CATProduct") < 1 Then
'MsgBox "当前文件不是Product,请打开Product.", ,msgboxtext
MsgBox "open Product first.", ,msgboxtext
Exit Sub
End If
Set cad = CATIA.ActiveDocument
Set sel = cad.Selection
Set prod = cad.Product.Products
If sel.count =0 Then
'MsgBox "未选取Parts,请先选取Parts", ,msgboxtext
MsgBox "No Parts selected, Select part first", ,msgboxtext
Exit Sub
End if
new_str = inputbox("输入部件号New Number:")
str_len = len(new_str)
j = j +1
For i = 1 To sel.Count
if left(prod.Item(i).PartNumber,str_len)<>new_str then
if j <10 then
prod.Item(i).PartNumber = new_str&"-00"&(j)
'prod.Item(i).name = "00"&(j)
else
prod.Item(i).PartNumber = new_str&"-0"&(j)
'prod.Item(i).name = "0"&(j)
end if
j = j + 1
end if
Next
''''''''''''''''''''''''''''''''''''''Rename Instance
Set objActiveProductDoc = Nothing
Set objCurrentProduct = Nothing
lngLstCtr = -1
lngIntCtr = 0
lngQtyCtr = 0
Set objTempCurrentProduct = Nothing
lngTempLstCtr = -1
lngTempIntCtr = 0
lngTempQtyCtr = 0
On Error Resume Next 'tell the processing to go to the next line if an error occurs
Set objActiveProductDoc = CATIA.ActiveDocument 'attempt to store the active product doc
If Err.Number <> 0 Then 'check if an error has been thrown from the above line
CATIA.StatusBar = "The active document must be a product."
MsgBox ("The active document must be a product."), vbExclamation 'if it cant find an active product doc then throw an error msg
CATIA.StatusBar = ""
End if 'end processing
On Error GoTo 0 'go back to handling errors normally instead of suppressing them by using Resume Next
'call a procedure to give temporary names to all instances
Call RenameTemporary(objActiveProductDoc.Product)
'call a recursive procedure to sort through the current product doc
Call SortThroughProductList(objActiveProductDoc.Product)
CATIA.StatusBar = "Done renaming." 'upadte the status bar
'set the catia application interactivity to true in order to refresh the tree and viewer
'CATIA.RefreshDisplay does not work unless it is within a VB script module within the product tree using KWA
'CATIA.ActiveWindow.ActiveViewer.Update does not work to refresh the product tree
CATIA.Interactive = True
End Sub
Public Sub RenameTemporary(ByRef objTempCurrentProduct)
'declare local variables
'loop through all of the components in the current product
For Each objTempChildProduct In objTempCurrentProduct.Products
'store part number in an array
lngTempLstCtr = lngTempLstCtr + 1
ReDim Preserve strTempList(lngTempLstCtr)
strTempList(lngTempLstCtr) = objTempChildProduct.PartNumber
'get appropriate instance number
lngTempQtyCtr = 0
For lngTempIntCtr = 0 To lngTempLstCtr
If strTempList(lngTempIntCtr) = objTempChildProduct.PartNumber Then
lngTempQtyCtr = lngTempQtyCtr + 1
End If
Next
'if this product has already been looped through then rename this instance but skip its components
If lngTempQtyCtr > 1 And objTempChildProduct.Products.Count > 0 Then
objTempChildProduct.Name = "Renaming" & "." & (UBound(strTempList) + 1)
CATIA.StatusBar = "Renaming" & "." & (UBound(strTempList) + 1)
Else
objTempChildProduct.Name = "Renaming" & "." & (UBound(strTempList) + 1)
CATIA.StatusBar = "Renaming" & "." & (UBound(strTempList) + 1)
If objTempChildProduct.Products.Count > 0 Then 'if there are components in the child then loop through them
Call RenameTemporary(objTempChildProduct.ReferenceProduct) 'call the temp rename procedure from within itself
End If
End If
Next
End Sub
Public Sub SortThroughProductList(ByRef objCurrentProduct)
'declare local variables
'loop through all of the components in the current product
For Each objChildProduct In objCurrentProduct.Products
'store part number in an array
lngLstCtr = lngLstCtr + 1
ReDim Preserve strList(lngLstCtr)
strList(lngLstCtr) = objChildProduct.PartNumber
'get appropriate instance number
lngQtyCtr = -1
For lngIntCtr = 0 To lngLstCtr
If strList(lngIntCtr) = objChildProduct.PartNumber Then
lngQtyCtr = lngQtyCtr + 1
End If
Next
'if this product has already been looped through then rename this instance but skip its components
If lngQtyCtr > 1 And objChildProduct.Products.Count > 0 Then
objChildProduct.Name = objChildProduct.PartNumber & "." & lngQtyCtr
CATIA.StatusBar = objChildProduct.PartNumber & "." & lngQtyCtr
Else
if lngQtyCtr = 0 then
objChildProduct.Name = right(objChildProduct.PartNumber,3)
else
objChildProduct.Name = right(objChildProduct.PartNumber,3) & "." & lngQtyCtr
end if
CATIA.StatusBar = objChildProduct.PartNumber & "." & lngQtyCtr
If objChildProduct.Products.Count > 0 Then 'if there are components in the child then loop through them
Call SortThroughProductList(objChildProduct.ReferenceProduct) 'call the procedure from within itself
End If
End If
Next
'End Sub
''''''''''''''''''''''''''''Save
CATIA.DisplayFileAlerts = False
Set oDocs = CATIA.Documents
docPath = oDocs.Item(1).Path
changePath = MsgBox("Current save location is: " & docPath & " Would you like to change file path?", vbYesNo)
If changePath = vbYes Then
docPath = InputBox("Enter new file path (eg. T:\_PROGRAMS\COMMERCIAL\_DATA\will.eagan\A330):", "File path")
End If
For v = 1 To oDocs.Count
If TypeName(oDocs.Item(v)) = "PartDocument" Then
Set oDoc2 = oDocs.Item(v)
Set oPart1 = oDoc2.Product
oDoc2.SaveAs docPath & "\" & oPart1.PartNumber & ".CATPart"
End If
Next 'v
For x = 1 To oDocs.Count
If TypeName(oDocs.Item(x)) = "ProductDocument" Then
Set oDoc1 = oDocs.Item(x)
Set oProduct1 = oDoc1.Product
oDoc1.SaveAs docPath & "\" & oProduct1.PartNumber & ".CATProduct"
End If
Next 'x
Msgbox "Save Finished!",,"SAVE FINISH!"
End Sub
RE: rename problem
1. It save all parts because you are counting all of them instead of counting a selection. I believe you can do the correction. For me renaming is done only in selection so this should be OK.
CODE --> CATScript
Set oDocs = CATIA.Documents docPath = oDocs.Item(1).Path changePath = MsgBox("Current save location is: " & docPath & " Would you like to change file path?", vbYesNo) If changePath = vbYes Then docPath = InputBox("Enter new file path (eg. T:\_PROGRAMS\COMMERCIAL\_DATA\will.eagan\A330):", "File path") End If For v = 1 To oDocs.Count If TypeName(oDocs.Item(v)) = "PartDocument" Then Set oDoc2 = oDocs.Item(v) Set oPart1 = oDoc2.Product oDoc2.SaveAs docPath & "\" & oPart1.PartNumber & ".CATPart" End If Next 'v For x = 1 To oDocs.Count If TypeName(oDocs.Item(x)) = "ProductDocument" Then Set oDoc1 = oDocs.Item(x) Set oProduct1 = oDoc1.Product oDoc1.SaveAs docPath & "\" & oProduct1.PartNumber & ".CATProduct" End If Next 'x Msgbox "Save Finished!",,"SAVE FINISH!"2. For me it save only once.
3. I have no errors running the script, can you upload a sample product when you get the error?
Regards
Fernando
https://picasaweb.google.com/102257836106335725208 - Romania
https://picasaweb.google.com/103462806772634246699... - EU
RE: rename problem
It's so complicated for me to moiidfied this macro. I give it up.I create a macro(see bellow)which rename all parts under a subproduct. If I want to rename some parts under a product, I first craete a temp product and cut the selected parts to it, rename, then cut them to their original product. it works quite good.
''''''''''''''
Language = "VBScript"
sub pn_re()
new_str = inputbox("Input new number :")
str_len = len(new_str)
Set prod_Doc = CATIA.ActiveDocument
Set prod = prod_Doc.Product
Set prods = prod.Products
j = j +1
For i = 1 To prods.Count
if left(prods.Item(i).PartNumber,str_len)<>new_str then
if j <10 then
prods.Item(i).PartNumber = new_str&"-00"&(j)
else
prods.Item(i).PartNumber = new_str&"-0"&(j)
end if
j = j + 1
end if
Next
End sub
'''''''''''''''''''''''''''''''''''''''
sub ins_re() 'instance
'initialize global variables
Set objActiveProductDoc = Nothing
Set objCurrentProduct = Nothing
lngLstCtr = -1
lngIntCtr = 0
lngQtyCtr = 0
Set objTempCurrentProduct = Nothing
lngTempLstCtr = -1
lngTempIntCtr = 0
lngTempQtyCtr = 0
On Error Resume Next 'tell the processing to go to the next line if an error occurs
Set objActiveProductDoc = CATIA.ActiveDocument 'attempt to store the active product doc
If Err.Number <> 0 Then 'check if an error has been thrown from the above line
CATIA.StatusBar = "The active document must be a product."
MsgBox ("The active document must be a product."), vbExclamation 'if it cant find an active product doc then throw an error msg
CATIA.StatusBar = ""
End if 'end processing
On Error GoTo 0 'go back to handling errors normally instead of suppressing them by using Resume Next
'call a procedure to give temporary names to all instances
Call RenameTemporary(objActiveProductDoc.Product)
'call a recursive procedure to sort through the current product doc
Call SortThroughProductList(objActiveProductDoc.Product)
CATIA.StatusBar = "Done renaming." 'upadte the status bar
'set the catia application interactivity to true in order to refresh the tree and viewer
'CATIA.RefreshDisplay does not work unless it is within a VB script module within the product tree using KWA
'CATIA.ActiveWindow.ActiveViewer.Update does not work to refresh the product tree
CATIA.Interactive = True
End Sub
Public Sub RenameTemporary(ByRef objTempCurrentProduct)
'declare local variables
'loop through all of the components in the current product
For Each objTempChildProduct In objTempCurrentProduct.Products
'store part number in an array
lngTempLstCtr = lngTempLstCtr + 1
ReDim Preserve strTempList(lngTempLstCtr)
strTempList(lngTempLstCtr) = objTempChildProduct.PartNumber
'get appropriate instance number
lngTempQtyCtr = 0
For lngTempIntCtr = 0 To lngTempLstCtr
If strTempList(lngTempIntCtr) = objTempChildProduct.PartNumber Then
lngTempQtyCtr = lngTempQtyCtr + 1
End If
Next
'if this product has already been looped through then rename this instance but skip its components
If lngTempQtyCtr > 1 And objTempChildProduct.Products.Count > 0 Then
objTempChildProduct.Name = "Renaming" & "." & (UBound(strTempList) + 1)
CATIA.StatusBar = "Renaming" & "." & (UBound(strTempList) + 1)
Else
objTempChildProduct.Name = "Renaming" & "." & (UBound(strTempList) + 1)
CATIA.StatusBar = "Renaming" & "." & (UBound(strTempList) + 1)
If objTempChildProduct.Products.Count > 0 Then 'if there are components in the child then loop through them
Call RenameTemporary(objTempChildProduct.ReferenceProduct) 'call the temp rename procedure from within itself
End If
End If
Next
End Sub
Public Sub SortThroughProductList(ByRef objCurrentProduct)
'declare local variables
'loop through all of the components in the current product
For Each objChildProduct In objCurrentProduct.Products
'store part number in an array
lngLstCtr = lngLstCtr + 1
ReDim Preserve strList(lngLstCtr)
strList(lngLstCtr) = objChildProduct.PartNumber
'get appropriate instance number
lngQtyCtr = -1
For lngIntCtr = 0 To lngLstCtr
If strList(lngIntCtr) = objChildProduct.PartNumber Then
lngQtyCtr = lngQtyCtr + 1
End If
Next
'if this product has already been looped through then rename this instance but skip its components
If lngQtyCtr > 1 And objChildProduct.Products.Count > 0 Then
objChildProduct.Name = objChildProduct.PartNumber & "." & lngQtyCtr
CATIA.StatusBar = objChildProduct.PartNumber & "." & lngQtyCtr
Else
if lngQtyCtr = 0 then
objChildProduct.Name = right(objChildProduct.PartNumber,3)
else
objChildProduct.Name = right(objChildProduct.PartNumber,3) & "." & lngQtyCtr
end if
CATIA.StatusBar = objChildProduct.PartNumber & "." & lngQtyCtr
If objChildProduct.Products.Count > 0 Then 'if there are components in the child then loop through them
Call SortThroughProductList(objChildProduct.ReferenceProduct) 'call the procedure from within itself
End If
End If
Next
End Sub
''''''''''''''''''''''''''''
Sub save_fn()
CATIA.DisplayFileAlerts = False
Set oDocs = CATIA.Documents
docPath = oDocs.Item(1).Path
changePath = MsgBox("Current save location is: " & docPath & " Would you like to change file path?", vbYesNo)
If changePath = vbYes Then
docPath = InputBox("Enter new file path (eg. T:\_PROGRAMS\COMMERCIAL\_DATA\will.eagan\A330):", "File path")
End If
For v = 1 To oDocs.Count
If TypeName(oDocs.Item(v)) = "PartDocument" Then
Set oDoc2 = oDocs.Item(v)
Set oPart1 = oDoc2.Product
oDoc2.SaveAs docPath & "\" & oPart1.PartNumber & ".CATPart"
End If
Next 'v
For x = 1 To oDocs.Count
If TypeName(oDocs.Item(x)) = "ProductDocument" Then
Set oDoc1 = oDocs.Item(x)
Set oProduct1 = oDoc1.Product
oDoc1.SaveAs docPath & "\" & oProduct1.PartNumber & ".CATProduct"
End If
Next 'x
Msgbox "Save Finished!",,"SAVE FINISH!"
End Sub
''''''''''''''''''''''''
Sub CATMain()
pn_re()
ins_re()
save_fn()
End Sub
RE: rename problem
do you have a way to delete the part number/part name?
regards,
bam