Part 2 Product Macro That Moves Parts

[jzecha]

I have a pretty robust Part 2 Product Macro that turns a part with multiple bodies into a product with parts made from those bodies.

The issue I run into is more customers are sending me files like this and I would like to improve it.

My part with multiple bodies will come in with names like this, and I clean them up to prevent duplicate name issues.

Part ________ Cleaned Up Names
Det01 ______ Det01
Det02 ______ Det02_01_of_03
Det02 ______ Det02_02_of_03
Det02 ______ Det02_03_of_03
Det03 ______ Det03_01_of_02
Det03 ______ Det03_02_of_02
Det04 ______ Det04

What I would like is a way Create Det02 and move it to the location of Det02_02_of_03 and Det02_03_of_03.

I would like any advice or input anyone can give me.

 

[Little Cthulhu]

So basically you want to have a single reference Det02.CATPart placed in an assembly as three instances (Det02.1, Det02.2, Det02.3)?

If so, post your code!

 

[jzecha]

That is exactly what I would like.

Currently I have 100 part assemblies that are actually 500 part assemblies because of all the instances.

There are a few functions I run before this to clean up the names, but the basic Part 2 Product code is this:

Public Sub Option4()

    Dim pctDone As Double
    Dim iLabelWidth As Integer
    iLabelWidth = 366
    
    
CATIA.RefreshDisplay = False
CATIA.DisplayFileAlerts = True


Dim i As Integer
Dim n As Integer
Dim name As String
Dim prt As String
Dim BodyName() As String
Dim partDocument1 As PartDocument
On Error Resume Next
Set partDocument1 = CATIA.ActiveDocument
    If Err.Description = "Type mismatch" Then
        MsgBox "You must have a CATPart as active document"
        Exit Sub
    End If
name = partDocument1.FullName
Dim part1 As Part
Set part1 = partDocument1.Part
Dim bodies1 As Bodies
Set bodies1 = part1.Bodies
Dim body1 As Body
Dim sel As Selection
Set sel = partDocument1.Selection
Dim documents2 As Documents
Dim partDocument2 As PartDocument
Dim part2 As Part
Dim specsAndGeomWindow1 As SpecsAndGeomWindow
                        


n = bodies1.Count

                        
                        
If n = 1 Then
    MsgBox "There is only one body in:" & Chr(13) & name & Chr(13) & "Part MUST have at least 2 Body's" & Chr(13) & "Macro will end now!!!", vbExclamation, "Warning"
Exit Sub
End If
prt = Left(partDocument1.name, Len(partDocument1.name) - 8)
For i = 1 To n


                        Start_Menu.lblStatus2.Caption = ("Part Body " & i & " of " & n)
                        Start_Menu.lblStatus1.Caption = ("Creating Parts")
                        pctDone = i / n
                        'MsgBox pctDone
                        Start_Menu.lblProgress.Width = iLabelWidth * pctDone
                        DoEvents
                        Start_Menu.FrameProgress.Caption = Format(pctDone, "0%")
                        DoEvents
                        
                        
    ReDim Preserve BodyName(i)
    BodyName(i) = bodies1.Item(i).name                 'turn on if you don't want to number part bodies and not include part name in new name
    Set partDocument1 = CATIA.ActiveDocument
    sel.Clear
    sel.Add bodies1.Item(i)
    sel.Copy
    Set documents2 = CATIA.Documents
    Set partDocument2 = documents2.Add("Part")
    partDocument2.Product.PartNumber = BodyName(i)
    Set partDocument2 = CATIA.ActiveDocument
    Set specsAndGeomWindow1 = CATIA.ActiveWindow
    Set part2 = partDocument2.Part
    Set BodyToDelete = part2.Bodies.Item(1)
    Dim sel2
    Set sel2 = partDocument2.Selection
    sel2.Clear
    sel2.Add part2
    sel2.Paste
    'sel2.PasteSpecial "CATPrtResultWithOutLink"  'Removes Colors
    part2.MainBody = part2.Bodies.Item(2)
    part2.Update
    sel.Clear
    sel.Add part2.Bodies.Item(1)
    CATIA.ActiveDocument.Selection.Add BodyToDelete
    CATIA.ActiveDocument.Selection.Delete
    part2.Update
    sel.Clear
    Set partDocument2 = CATIA.ActiveDocument
    partDocument2.SaveAs Left(name, Len(name) - Len(partDocument1.name)) & BodyName(i) & ".CATPart"
    specsAndGeomWindow1.Close
    partDocument2.Close
Next

Dim documents1 As Documents
Set documents1 = CATIA.Documents
Dim productDocument1 As ProductDocument
Set productDocument1 = documents1.Add("Product")
productDocument1.Product.PartNumber = "Product_From_Part_" & Left(partDocument1.name, Len(partDocument1.name) - 8)
Dim product1 As Product
Set product1 = productDocument1.Product
Dim products1 As Products
Set products1 = product1.Products
Dim arrayOfVariantOfBSTR1(0)
Dim constraints1 As Constraints
Set constraints1 = product1.Connections("CATIAConstraints")
Dim reference1 As Reference
Dim constraint1 As Constraint
Dim ConString As String

                        Start_Menu.lblStatus1.Caption = ("Creating Fix Constraints")

For i = 1 To n
    ConString = ""
    ConString = "Product_From_Part_" & prt & "/" & BodyName(i) & ".1/!" & " " & prt & "/" & BodyName(i) & ".1/"
    arrayOfVariantOfBSTR1(0) = Left(name, Len(name) - Len(partDocument1.name)) & BodyName(i) & ".CATPart"
    Set products1Variant = products1
    StrConstrain = "Product_From_Part_" & Left(partDocument1.name, Len(partDocument1.name) - 8) & "/" & Left(partDocument1.name, Len(partDocument1.name) - 8) & "_PartBody.1/!" & "Product_From_Part_" & Left(partDocument1.name, Len(partDocument1.name) - 8) & "/" & Left(partDocument1.name, Len(partDocument1.name) - 8) & "_PartBody.1/"
    products1Variant.AddComponentsFromFiles arrayOfVariantOfBSTR1, "All"
    Set reference1 = product1.CreateReferenceFromName(ConString)
    Set constraint1 = constraints1.AddMonoEltCst(catCstTypeReference, reference1)
Next

'CATIA.RefreshDisplay = True
'MsgBox "All Done!"

Call HidePlanes


CATIA.DisplayFileAlerts = True
        
        
        Start_Menu.Hide
'        Start_Menu.OkCancel_Buttons.Visible = False
'        Start_Menu.Partt2ProductRunning.Visible = False
'        Start_Menu.OkCancel_Buttons2.Visible = True
'        'Start_Menu.Height = 330
    

CATIA.StatusBar = "Macro Finished"
MsgBox "All Done"

End Sub

 

[Little Cthulhu]

How do you ensure that multiple original bodies that share the same name are identical?
Is it possible that they differ not only by position, but also by rotation?

 

[jzecha]

This is something we have to trust from out customers.
We will do a comparison once we split it apart afterward.

These are usually designed in NX and come over as a part instead of a product.
The parts will be moved in position and rotation.

This is going to be a complicated code, just looking for ideas to get me started.

 

[Little Cthulhu]

Not much you can do without some kind of AI analysis. The problem is you have to deduce both position and rotation because bodies doesn't have axis of their own. And you have to somehow move copied body to 0.0.0 of new CATPart.

In theory if all bodies have been created exactly the same way (essentially by copy-pasting) you can get first fact of each body and use it's position and normal vector as a reference.

Measuring inertia matrix won't do the trick for boies with symmetrical geometry.

In conclusion, I suggest developing a human-assisted scenario to move copied body to 0.0.0 in new parts coordinates.