×
INTELLIGENT WORK FORUMS
FOR ENGINEERING PROFESSIONALS

Log In

Come Join Us!

Are you an
Engineering professional?
Join Eng-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Eng-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Jobs

rename problem

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

RE: rename problem

(OP)
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

RE: rename problem

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.

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

(OP)
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

RE: rename problem

hello,

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

regards,
bam

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Eng-Tips Forums free from inappropriate posts.
The Eng-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Eng-Tips forums is a member-only feature.

Click Here to join Eng-Tips and talk with other members!


Resources