Catia V5 Macro to Generate a new .catpart in a product with published data from another 1

[CAD_ROB]

Hi, Im after some advice whether its possible to create a macro in Catia V5 to take a product with a number of .catparts, those catparts have a partbody that are published. I want the macro to be able to generate a new catpart in a different product and within that new .catpart have the published partbody link from the other .catpart from the other product. See Image with this post. So from the list Item 0010 would become 0110 with the published Partbody from 0010.

Any advice is welcome... Thanks.

 

[weagan22]

I was feeling bored so here you go friend. I think the code comments and error handling messages speak for themselves on function.

Sub CATMain()
    'Check to make sure the user is on the assembly workbench
    If CATIA.GetWorkbenchId <> "Assembly" Then
        MsgBox "Only works on the Assembly Design workbench", , "Workbench Error"
        Exit Sub
    End If
    
    'Clear the undo stack in CATIA so that deleted files still in memory do not cause an error. Mainly caused during testing
    CATIA.StartCommand ("Clear History")
    
    Dim uSel As Selection
    Set uSel = CATIA.ActiveDocument.Selection
    
    'Check to make sure at least 2 items were selected
    If uSel.Count < 2 Then
        MsgBox "You must select two products before running this macro.", , "Selection Qty Error"
        Exit Sub
    End If
    
    'Check to make sure the selected items are products
    If TypeName(uSel.Item(1).Value) <> "Product" Or TypeName(uSel.Item(2).Value) <> "Product" Then
        MsgBox "Both selected items must be products", , "Selection Type Error"
        Exit Sub
    End If
    
    'Get the first selected product, this is the one with the master part files
    Dim masterProd0010 As Product
    Set masterProd0010 = uSel.Item(1).Value
    
    'Get the second selected product, this will be where new parts are going to be made
    Dim newProd0110 As Product
    Set newProd0110 = uSel.Item(2).Value
    
    'Check to make sure the newProd is actually a product node not a part
    If TypeName(newProd0110.ReferenceProduct.Parent) <> "ProductDocument" Then
        MsgBox "Both selected items must be products", , "Selection Type Error"
        Exit Sub
    End If
    
    'Loop through all of the products in the master product
    For i = 1 To masterProd0010.Products.Count
        Dim loopProd As Product
        Set loopProd = masterProd0010.Products.Item(i)
    
        'If the looped product is a part node then execute the copy code
        If TypeName(loopProd.ReferenceProduct.Parent) = "PartDocument" Then
        
            'Get the part number of the master part that is being copied
            Dim startPartNum As String
            startPartNum = loopProd.PartNumber
            
            'Create the part number for the new file that is going to be made. If there is a dash in the master part file change the extention to -0110 else addend -0110 to the whole part number
            Dim newPartName As String
            Dim dashPos As Integer
            dashPos = InStr(1, startPartNum, "-", vbTextCompare)
            If dashPos = 0 Then
                newPartName = startPartNum & "-0110"
            Else
                newPartName = Left(startPartNum, dashPos) & "0110"
            End If
            
            'Create the new part and get the object, still causes an error if the part number already exists in the CATIA session but this in not trivial error to handle here
            Dim newPartProd As Product
            Set newPartProd = newProd0110.Products.AddNewComponent("Part", newPartName)
            Dim newPart As Part
            Set newPart = newPartProd.ReferenceProduct.Parent.Part
            
            'Get the main body from the master file to be copied
            Dim copyBody As Body
            Set copyBody = loopProd.ReferenceProduct.Parent.Part.MainBody
            
            'Select and copy the body from the last step
            uSel.Clear
            uSel.Add copyBody
            uSel.Copy
            
            'Paste the body into the newly created part
            uSel.Clear
            uSel.Add newPart
            uSel.PasteSpecial ("CATPrtResult")
            
            'If a body was added to the new part then handle the new part update
            If newPart.Bodies.Count = 2 Then
                'Change the main body in the new part to the new body
                newPart.MainBody = uSel.Item(1).Value
                newPart.MainBody.Name = "PartBody"
                
                'Delete the empty body that remains in the new part
                uSel.Clear
                uSel.Add newPart.Bodies.Item(1)
                uSel.Delete
                                
                'Update the new part so the the body is up to date
                newPart.Update
            End If
        End If
    Next
End Sub

 

[CAD_ROB]

Amazing! Thanks for the response weagan22 much appreciated. Ive tried to run the macro and it creates the first catpart in the 2nd product and publishes the partbody as i want, but then it seems to get stuck from there, like it doesn't know how to add the next number. Is the intended coding to work down the list of catparts in the first product and create one in the 2nd with a published partbody?

 

[weagan22]

Yes, the intent is that for every part in the masterProd0010 (the first selected product) an accompanying part is created in the newProd0110 (the second selected product). Sorry, I didn't look at your part numbering scheme closely enough. This error is being caused because it it trying to create another part with the exact same part number "ZRD00247DRJ-0110" when the next one should be "ZRD00247DRJ-0111".

As an aside, I would recommend that you run this in VBA not as a CATScript. It shouldn't make a difference but it could.

Sub CATMain()
    'Check to make sure the user is on the assmbly workbench
    If CATIA.GetWorkbenchId <> "Assembly" Then
        MsgBox "Only works on the Assembly Design workbench", , "Workbench Error"
        Exit Sub
    End If
    
    'Clear the undo stack in CATIA so that deleted files still in memory do not cause an error. Mainly caused during testing
    CATIA.StartCommand ("Clear History")
    
    Dim uSel As Selection
    Set uSel = CATIA.ActiveDocument.Selection
    
    'Check to make sure at least 2 items were selected
    If uSel.Count < 2 Then
        MsgBox "You must select two products before running this macro.", , "Selection Qty Error"
        Exit Sub
    End If
    
    'Check to make sure the selected items are products
    If TypeName(uSel.Item(1).Value) <> "Product" Or TypeName(uSel.Item(2).Value) <> "Product" Then
        MsgBox "Both selected items must be products", , "Selection Type Error"
        Exit Sub
    End If
    
    'Get the first selected product, this is the one with the master part files
    Dim masterProd0010 As Product
    Set masterProd0010 = uSel.Item(1).Value
    
    'Get the second selected product, this will be where new parts are going to be made
    Dim newProd0110 As Product
    Set newProd0110 = uSel.Item(2).Value
    
    'Check to make sure the newProd is actually a product node not a part
    If TypeName(newProd0110.ReferenceProduct.Parent) <> "ProductDocument" Then
        MsgBox "Both selected items must be products", , "Selection Type Error"
        Exit Sub
    End If
    
    'Loop through all of the products in the master product
    For i = 1 To masterProd0010.Products.Count
        Dim loopProd As Product
        Set loopProd = masterProd0010.Products.Item(i)
    
        'If the looped product is a part node then execute the copy code
        If TypeName(loopProd.ReferenceProduct.Parent) = "PartDocument" Then
        
            'Get the part number of the master part that is being copied
            Dim startPartNum As String
            startPartNum = loopProd.PartNumber
            
            'Create the part number for the new file that is going to be made. If there is a dash in the master part file change the extention to -0110 else addend -0110 to the whole part number
            Dim newPartName As String
            
            'Get the position of the '-' in the part number
            Dim dashPos As Integer
            dashPos = InStr(1, startPartNum, "-", vbTextCompare)
            
            If dashPos = 0 Then
                'If there isn't a dash then just addend -0110 onto the master part number
                newPartName = startPartNum & "-0110"
            Else
                'Get the extension number after the dash
                Dim extNum As String
                extNum = Right(startPartNum, Len(startPartNum) - dashPos)
                
                'If the extension is numeric then increment
                If IsNumeric(extNum) Then
                    'Convert the old number to an integer
                    Dim oldNum As Integer
                    oldNum = CInt(Right(startPartNum, Len(startPartNum) - dashPos))
                    
                    'Increment the old number by 100 to get the new number
                    Dim newNum As Integer
                    newNum = oldNum + 100
                    
                    'Concatenate the new number onto the original base number
                    newPartName = Left(startPartNum, dashPos) & "0" & newNum
                Else
                    'If the extension isn't numeric then just addend -0110 onto the master part number
                    newPartName = startPartNum & "-0110"
                End If
            End If
            
            'Create the new part and get the object
            Dim newPartProd As Product
            Set newPartProd = newProd0110.Products.AddNewComponent("Part", newPartName)
            Dim newPart As Part
            Set newPart = newPartProd.ReferenceProduct.Parent.Part
            
            'Get the main body from the master file to be copied
            Dim copyBody As Body
            Set copyBody = loopProd.ReferenceProduct.Parent.Part.MainBody
            
            'Select and copy the body from the last step
            uSel.Clear
            uSel.Add copyBody
            uSel.Copy
            
            'Paste the body into the newly created part
            uSel.Clear
            uSel.Add newPart
            uSel.PasteSpecial ("CATPrtResult")
            
            'If a body was added to the new part then handle the new part update
            If newPart.Bodies.Count = 2 Then
                'Change the main body in the new part to the new body
                newPart.MainBody = uSel.Item(1).Value
                newPart.MainBody.Name = "PartBody"
                
                'Delete the empty body that remains in the new part
                uSel.Clear
                uSel.Add newPart.Bodies.Item(1)
                uSel.Delete
                                
                'Update the new part so the the body is up to date
                newPart.Update
            End If
        End If
    Next
End Sub

 

[CAD_ROB]

It works beautifully. The final problem I have is that within the first product ive got multiple instances of the same part. Therefore when it tries to create 50.1 to 150 it works but then 50.2 to 151 it falls over because it sees there's already a 150 been created. As you been amazing so far. my part numbering goes as follows. Items 0010 to 0030 becomes 0110 to 0130 in Product 2. Items 0050 becomes 150, 151, 152 depending on the no. of instances. Item 0060 becomes 0160, 161, 162, 163 etc depending on number of instances. Item 0070 becomes 0300,0301 etc depending on istances, Item 0080 becomes 0350, 0351 etc. Is it possible for it to recognise those numbers and if for instance there wasn't a 0070 in product 1 it ignores that code command.

 

[weagan22]

Scope creep!

 

[CAD_ROB]

Hi, Im still having trouble with the macro falling over because of my catparts having the same Item number, is there a way to identify the Instances of the item number and add it to the item number so that it can see them as seperate catparts when running the macro?

 

[weagan22]

Yes, there is.

 

[CAD_ROB]

I'm a young engineer trying to make his way in this world, im sure that you've been there. im trying to learn the best I can with this stuff and came to this forum to try and get the support from experts that can make me learn a lot faster than it says in a code book. I always find the best way is to learn is from examples then in the future I can apply this method across other jobs I might need it for. Thank you for your help so far Weagan22. I sense you have been upset but I didn't want to bombard the message straight away with my keenness to learn. If you can point me to any websites or books or links to help me with my example that would be good.

 

[MarkAF]

Hi Rob,
I don't have any specifics for your immediate problem, but would like to offer a general encouragement and direction. Some of what you are asking can be solved on your own by working with some of the basic tools from the code books.

Much of my learning around the basics was from a book "Excel VBA for Dummies." Of course there were no CATIA methods or objects, but it was a good training in several points: the basics of the language, how to work with different types of loops, make counters, do string manipulation, and learn the data model by examining the watch window on objects in the VBA editor. These are the general tools that you need for your problem. Go ahead and spend some time trudging through the simple stuff - you may find that you learn a lot of the very common tools that will help to solve your immediate problem. For example, the question of finding Instances should be solved if you work through the Product object model in a watch window.

From there, a forum like this is great for working through the specific oddities and quirky problems.

Have patience, dig in and work through the basics to get a broad understanding, and, good luck.


ps - Making CATIA and Excel work together is very useful and powerful, so whatever you may learn in the Excel realm can also be really good generally. There's loads of samples, tutorials, and forums around Excel coding; far more than CATIA.

 

[CAD_ROB]

Thanks for your reply Mark, I will take the advice on board and try it out.

 

[weagan22]

Sub CATMain()
    'Check to make sure the user is on the assembly workbench
    If CATIA.GetWorkbenchId <> "Assembly" Then
        MsgBox "Only works on the Assembly Design workbench", , "Workbench Error"
        Exit Sub
    End If
    
    'Clear the undo stack in CATIA so that deleted files still in memory do not cause an error. Mainly caused during testing
    CATIA.StartCommand ("Clear History")
    
    Dim uSel As Selection
    Set uSel = CATIA.ActiveDocument.Selection
    
    'Check to make sure at least 2 items were selected
    If uSel.Count < 2 Then
        MsgBox "You must select two products before running this macro.", , "Selection Qty Error"
        Exit Sub
    End If
    
    'Check to make sure the selected items are products
    If TypeName(uSel.Item(1).Value) <> "Product" Or TypeName(uSel.Item(2).Value) <> "Product" Then
        MsgBox "Both selected items must be products", , "Selection Type Error"
        Exit Sub
    End If
    
    'Get the first selected product, this is the one with the master part files
    Dim masterProd0010 As Product
    Set masterProd0010 = uSel.Item(1).Value
    
    'Get the second selected product, this will be where new parts are going to be made
    Dim newProd0110 As Product
    Set newProd0110 = uSel.Item(2).Value
    
    'Check to make sure the newProd is actually a product node not a part
    If TypeName(newProd0110.ReferenceProduct.Parent) <> "ProductDocument" Then
        MsgBox "Both selected items must be products", , "Selection Type Error"
        Exit Sub
    End If
    
    'Loop through all of the products in the master product
    For i = 1 To masterProd0010.Products.Count
        Dim loopProd As Product
        Set loopProd = masterProd0010.Products.Item(i)
    
        'If the looped product is a part node then execute the copy code
        If TypeName(loopProd.ReferenceProduct.Parent) = "PartDocument" Then
        
            'Get the part number of the master part that is being copied
            Dim startPartNum As String
            startPartNum = loopProd.PartNumber
            
            'Get the instance name of the master part that is being copied
            Dim startPartName As String
            startPartName = loopProd.Name
            
            
            'Create the part number for the new file that is going to be made. If there is a dash in the master part file change the extension to -0110 else addend -0110 to the whole part number
            Dim newPartName As String
            
            
            
            'Get the position of the '-' in the part number
            Dim dashPos As Integer
            dashPos = InStr(1, startPartNum, "-", vbTextCompare)
            
            If dashPos = 0 Then
                'If there isn't a dash then just addend -0110 onto the master part number
                newPartName = startPartNum & "-0110"
            Else
                'Get the extension number after the dash
                Dim extNum As String
                extNum = Right(startPartNum, Len(startPartNum) - dashPos)
                
                'If the extension is numeric then increment
                If IsNumeric(extNum) Then
                    'Convert the old number to an integer
                    Dim oldNum As Integer
                    oldNum = CInt(extNum)
                    
                    'Get the instance number
                    Dim instNum As Integer
                    instNum = 0
                    
                    'Get the position of the '.' in the instance name
                    Dim decPos As Integer
                    decPos = InStr(1, startPartName, ".", vbTextCompare)
                    
                    'If there is a decimal in the instance name then get the number else number is 0
                    If decPos = 0 Then
                        instNum = 0
                    Else
                        'Get the number string from the name
                        Dim instNumStr As String
                        instNumStr = Right(startPartName, Len(startPartName) - decPos)
                        
                        'If it is numeric then set the instance number to the retrieved string, decremented by 1
                        If IsNumeric(instNumStr) Then
                            instNum = CInt(instNumStr) - 1
                        Else
                            instNum = 0
                        End If
                    End If
            
                    'Increment the old number by 100 to get the new number, also add the instance number
                    Dim newNum As Integer
                    newNum = oldNum + 100 + instNum
                    
                    'Concatenate the new number onto the original base number
                    newPartName = Left(startPartNum, dashPos) & Format(newNum, "0000")
                Else
                    'If the extension isn't numeric then just addend -0110 onto the master part number
                    newPartName = startPartNum & "-0110"
                End If
            End If
            
            
            
            
            'Create the new part and get the object
            Dim newPartProd As Product
            Set newPartProd = newProd0110.Products.AddNewComponent("Part", newPartName)
            Dim newPart As Part
            Set newPart = newPartProd.ReferenceProduct.Parent.Part
            
            
            'Move the new part to the same position as the original one
            Dim oAxisComponentsArray(11)
            Dim loopProdUnBnd
            Set loopProdUnBnd = loopProd

            loopProdUnBnd.position.GetComponents oAxisComponentsArray

            Dim newPartProdUnBnd
            Set newPartProdUnBnd = newPartProd

            newPartProdUnBnd.position.SetComponents oAxisComponentsArray
 
 
            'Select and copy all the bodies from the original part
            uSel.Clear
            uSel.Add loopProd
            uSel.Search ("CATPrtSearch.BodyFeature,sel")
            uSel.Copy
            
            'Paste the body/bodies into the newly created part
            uSel.Clear
            uSel.Add newPart
            uSel.PasteSpecial ("CATPrtResult")
            
            'If a body was added to the new part then handle the new part update
            If newPart.Bodies.Count > 1 Then
                'Change the main body in the new part to the new body
                newPart.MainBody = uSel.Item(1).Value
                newPart.MainBody.Name = "PartBody"
                
                'Delete the empty body that remains in the new part
                uSel.Clear
                uSel.Add newPart.Bodies.Item(1)
                uSel.Delete
                                
                'Update the new part so the the body is up to date
                newPart.Update
            End If
            
        End If
    Next
End Sub

 

[CAD_ROB]

Thanks Wegan22. I had to modify some sections of your code to make it work for me and adjust the numbering but I've got it to do what I needed.

Sub CATMain()
'Check to make sure the user is on the assembly workbench
If CATIA.GetWorkbenchId <> "Assembly" Then
MsgBox "Only works on the Assembly Design workbench", , "Workbench Error"
Exit Sub
End If

'Clear the undo stack in CATIA so that deleted files still in memory do not cause an error. Mainly caused during testing
CATIA.StartCommand ("Clear History")

Dim uSel As Selection
Set uSel = CATIA.ActiveDocument.Selection

'Check to make sure at least 2 items were selected
If uSel.Count < 2 Then
MsgBox "You must select two products before running this macro.", , "Selection Qty Error"
Exit Sub
End If

'Check to make sure the selected items are products
If TypeName(uSel.Item(1).Value) <> "Product" Or TypeName(uSel.Item(2).Value) <> "Product" Then
MsgBox "Both selected items must be products", , "Selection Type Error"
Exit Sub
End If

'Get the first selected product, this is the one with the master part files
Dim masterProd0010 As Product
Set masterProd0010 = uSel.Item(1).Value

'Get the second selected product, this will be where new parts are going to be made
Dim newProd0110 As Product
Set newProd0110 = uSel.Item(2).Value

'Check to make sure the newProd is actually a product node not a part
If TypeName(newProd0110.ReferenceProduct.Parent) <> "ProductDocument" Then
MsgBox "Both selected items must be products", , "Selection Type Error"
Exit Sub
End If

'Loop through all of the products in the master product
For i = 1 To masterProd0010.Products.Count
Dim loopProd As Product
Set loopProd = masterProd0010.Products.Item(i)

'If the looped product is a part node then execute the copy code
If TypeName(loopProd.ReferenceProduct.Parent) = "PartDocument" Then

'Get the part number of the master part that is being copied
Dim startPartNum As String
startPartNum = loopProd.PartNumber

'Get the instance name of the master part that is being copied
Dim startPartName As String
startPartName = loopProd.Name


'Create the part number for the new file that is going to be made. If there is a dash in the master part file change the extension to -0110 else addend -0110 to the whole part number
Dim newPartName As String



'Get the position of the '-' in the part number
Dim dashPos As Integer
dashPos = InStr(1, startPartNum, "-", vbTextCompare)

If dashPos = 0 Then
'If there isn't a dash then just addend -0110 onto the master part number
newPartName = startPartNum & "-0110"
Else
'Get the extension number after the dash
Dim extNum As String
extNum = Right(startPartNum, Len(startPartNum) - dashPos)

'If the extension is numeric then increment
If IsNumeric(extNum) Then
'Convert the old number to an integer
Dim oldNum As Integer
oldNum = CInt(extNum)


'Get the instance number
Dim instNum As Integer
instNum = 0

'Get the position of the '.' in the instance name
Dim decPos As Integer
decPos = InStr(1, startPartName, ".", vbTextCompare)

'If there is a decimal in the instance name then get the number else number is 0
If decPos = 0 Then
instNum = 0
Else
'Get the number string from the name
Dim instNumStr As String
instNumStr = Right(startPartName, Len(startPartName) - decPos)

'If it is numeric then set the instance number to the retrieved string, decremented by 1
If IsNumeric(instNumStr) Then
instNum = CInt(instNumStr) - 1
Else
instNum = 0



End If
End If

Dim oldNum1 As Integer
oldNum1 = 0

Dim oldNum2 As Integer
oldNum2 = 0


Dim oldNum3 As Integer
oldNum3 = 0


If oldNum >= 70 Then oldNum1 = 130

If oldNum >= 80 Then oldNum2 = 170

If oldNum1 = 130 AND oldNum2 = 170 Then oldNum3 = 130


End If



'Increment the old number by 100 to get the new number, also add the instance number
Dim newNum As Integer
newNum = oldNum + oldNum1 + oldNum2 - oldNum3 + 100 + instNum

'Concatenate the new number onto the original base number
newPartName = Left(startPartNum, dashPos) & "0" & newNum

End If
End If


'Create the new part and get the object
Dim newPartProd As Product
Set newPartProd = newProd0110.Products.AddNewComponent("Part", newPartName)
Dim newPart As Part
Set newPart = newPartProd.ReferenceProduct.Parent.Part





'Select and copy all the bodies from the original part
uSel.Clear
uSel.Add loopProd
uSel.Search ("CATPrtSearch.BodyFeature,sel")
uSel.Copy

'Paste the body/bodies into the newly created part
uSel.Clear
uSel.Add newPart
uSel.PasteSpecial ("CATPrtResult")

'If a body was added to the new part then handle the new part update
If newPart.Bodies.Count > 1 Then
'Change the main body in the new part to the new body
newPart.MainBody = uSel.Item(1).Value
newPart.MainBody.Name = "PartBody"

'Delete the empty body that remains in the new part
uSel.Clear
uSel.Add newPart.Bodies.Item(1)
uSel.Delete

'Update the new part so the the body is up to date
newPart.Update
End If

Next
End Sub

 

[CAD_ROB]

There's one final addition im trying to maybe add to the above script and that is for every newly created Part, I want to split the partbody with an external reference surface that is held in my data model catpart(surface is published). Ive read a few articles saying that I would need to PasteSpecial "CATPrtResult" the surface into each newly created part and then use the reference to then create the split.

Here's some of the code im trying to add to the other script. It seems to fall over at the user selection stage,

Dim shapeFactory1 As Factory
Set shapeFactory1 = newPart.ShapeFactory

'Trying to use the user selected surface?'
Dim reference1 As Reference
Set reference1 = uSel.Item(3).Value

Dim split1 As Split
Set split1 = shapeFactory1.AddNewSplit(reference1, catPositiveSide)

Dim hybridBodies1 As HybridBodies
Set hybridBodies1 = newPart.HybridBodies

Dim hybridBody1 As HybridBody
Set hybridBody1 = hybridBodies1.Item("External References")

Dim hybridShapes1 As HybridShapes
Set hybridShapes1 = hybridBody1.HybridShapes

Dim hybridShapeSurfaceExplicit1 As HybridShape
Set hybridShapeSurfaceExplicit1 = hybridShapes1.Item("PRE-MACHINED SURFACE")

Dim reference2 As Reference
Set reference2 = newPart.CreateReferenceFromObject(hybridShapeSurfaceExplicit1)

split1.Surface = reference2

split1.SplitSide = 1

newPart.Update