rename problem

[llbbyy]

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

 

[ferdo]

This is not somehow similar with using Save Management-Pattern Name ?

Regards
Fernando

https://picasaweb.google.com/102257836106335725208

- Romania

https://picasaweb.google.com/103462806772634246699/

- EU

 

[llbbyy]

some similaer with Save Management,but more faster, I search the fuorum and combined some macoo, basicly realize the function , but still have some problems,ie.
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

 

[ferdo]

Hi

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.

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

[COLOR=#EF2929]For v = 1 To oDocs.Count[/color]

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

 

[llbbyy]

I chsnged "For v = 1 To oDocs.Count" to For "v = 1 To sel.Count",it doesn't work.there are also a lot other problems, such as: when select the parts for the second time,snd run the macro, "open Product first" will show.
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

 

[bambambidam]

hello,

do you have a way to delete the part number/part name?

regards,
bam