Macros CATIA V5 : Create a PRODUCT from an ALL.CATPART

[JordanCaron]

Hi guys,

I already have a macro to create a CATPRODUCT from an ALL.CATPART.
Unfortunately the macro replace every body in the ALLCATPART by a CATPART and add it to a PRODUCT.

Here is my issue. I have an ALLCATPART with 1000 bodies but only 3 differents geometry. So if I run my macro it will create 1000 CATPART with different axis system.
I would love to have a Macro that create only 3 CATPART and put them in position in the CATPRODUCT.

Here is the cat vba I have, but it's not usefull in my situation.

'L'objectif de la macro est de créer un assemblage multipart à partir d'une piece multi body



'********************************************************************************************

'Recuperation du document à decomposer

Dim les_docs As Documents

Set les_docs = CATIA.Documents



On Error Resume Next

Dim part_doc As PartDocument

Dim lapart As Part

Set part_doc = CATIA.ActiveDocument



If Err.Number = 0 Then

'c'est une part

Set lapart = part_doc.Part

Else

'c'est un produit

Err.Clear

Dim pdt_doc As ProductDocument

Set pdt_doc = CATIA.ActiveDocument

Dim pdt As Product

Set pdt = pdt_doc.Product

Dim lesprods As Products

Set lesprods = pdt.Products

Set lapart = lesprods.Item(1).ReferenceProduct.Parent.Part

End If

'********************************************************************************************



'********************************************************************************************

'Recuperation du nom de la part multi corps et création du produit correspondant

Dim Prod_doc As ProductDocument

Set Prod_doc = les_docs.Add("Product")

Prod_doc.Product.PartNumber = lapart.Name



If Err.Number <> 0 Then

MsgBox "Renommage du document créé impossible" & vbCrLf & "Vérifiez si un document avec un nom identique ne figure pas déjà dans la session..."

CATIA.DisplayFileAlerts = False

CATIA.Documents.Item(Prod_doc.Name).Close

Err.Clear

Exit Sub

End If

'********************************************************************************************



'********************************************************************************************

'Recuperation des Body non vide , creation d'une part dans le product , renommage de la part et Copier Coller Avec ou sans lien

Dim Msg, Style, Title, Response, nombody As String



Msg = "Souhaitez-vous des liens entre pièces?"

Style = vbYesNo + vbDefaultButton2 ' Définit les boutons.

Title = "Associativité... " ' Définit le titre.

Response = MsgBox(Msg, Style, Title) ' Affiche le message.



For i = 1 To lapart.Bodies.Count

If lapart.Bodies.Item(i).InBooleanOperation = False And lapart.Bodies.Item(i).Shapes.Count <> 0 Then



nombody = lapart.Bodies.Item(i).Name

If InStr(nombody, "\") <> 0 Then nombody = Replace(nombody, "\", "_")

Prod_doc.Product.Products.AddNewComponent "CATPart", nombody



If Response = vbYes Then

' L'utilisateur a choisi des liens.

CCLV2 Prod_doc.Product, lapart.Bodies.Item(i), Prod_doc.Product.Products.Item(Prod_doc.Product.Products.Count)

Else

' L'utilisateur a choisi pas de liens

CCLV1 Prod_doc.Product, lapart.Bodies.Item(i), Prod_doc.Product.Products.Item(Prod_doc.Product.Products.Count)

End If



End If

Next



Prod_doc.Product.Update

'********************************************************************************************



End Sub



Public Sub CCLV1(Context As Product, i_object_to_copy, CibleProd As Product)



Set oselection = Context.ReferenceProduct.Parent.Selection

Set oTargetPart = CibleProd.ReferenceProduct.Parent.Part

oselection.Clear

oselection.Add i_object_to_copy

'MsgBox oSelection.Count & ObjtoCCLname

oselection.Copy

oselection.Clear

oselection.Add oTargetPart

oselection.PasteSpecial "CATPrtResultWithOutLink"



End Sub



Public Sub CCLV2(Context As Product, i_object_to_copy, CibleProd As Product)



Set oselection = Context.ReferenceProduct.Parent.Selection

Set oTargetPart = CibleProd.ReferenceProduct.Parent.Part

oselection.Clear

oselection.Add i_object_to_copy

'MsgBox oSelection.Count & ObjtoCCLname

oselection.Copy

oselection.Clear

oselection.Add oTargetPart

oselection.PasteSpecial "CATPrtResult"



End Sub



Please can you help me ?
Do you have a macro that could do what I need ?

Best regards,

Jordan Caron

 

[LWolf]

so you are asking to create instances of the three unique parts; are the 1000 bodies named in relation to the three parts, or are you planning on measuring the individual bodies to determine the three unique parts?...

regards,
LWolf

 

[JordanCaron]

HI LWOlf,

I have 1000 bodies, but in the CATPRODUCT I would love to have instances of the 3 parts , you are right.
Basicaly I would love to have a macro that identify the 3 different geometry from all the bodies present in the ALLCATPART and create 3 parts to be instancied in a CATPRODUCT at the same position than the bodies in the ALLCATPART.

I don't know if I make myself clear.

 

[Little Cthulhu]

I don't think it's doable. If this is a one-time task do it manually (possibly with little helper macros).

Your macro creates 1000 unique parts with geometry pasted in the same position as in all.catpart. That's like designing a front wheel of a car while standing at it's trunk in the back.

That looks ok, but is an absolute mess to work with. In reality geometry should be pasted at origin of part's local axis system and then the whole part instance should be moved to match original position.

The fundamental problem here is not only to identify similar part bodies, but to calculate how they are positioned.

I guess you could try creating a footprint of a body by calculating center of gravity for it's generative geometry (i.e. for each vertex, edge and face inside a body), normalizing it (picking one CoG as body's local axis system origin and translating all other CoGs accordingly) and building a local axis system. Then find matching footprints to identify similar bodies (with respect to possible rotation).
Then copy-paste one of matching bodies to a part and move the result to part's origin.
Finally start instantiating parts and move and rotate instances based on original footprints.

If there's no rotation at all (similar bodies differ only by position) then it becomes a bit easier to do.

 

[JordanCaron]

Thanks a lot Little Cthulhu,

I thought about what you said and I will do it in 3 steps.

STEP 1 : : Transfor the ALLCATPART in CATPRODUCT
Here I use the macro below, that will create a product with 1000 unique parts with geometry pasted in the same position as in all.catpart.


STEP 2 : : Get the center of gravity of every part refering to the product axis system

STEP 3 : : Create a new CATPRODUCT and add instance of the CATPART in the right position, based on the point I got in step 2


So for the step 1, the macro below is working.

FOr the Step 2 I'm facing some issues. I tried this but it is not working :


Sub Main()
Dim Main_Product As Product
Set Main_Product = CATIA.ActiveDocument.Product
Dim AxisComponentsArray(11)
Dim Tab_Result(1 To 100, 1 To 13)

For i = 1 To Main_Product.Products.Count
Instance_Name = Main_Product.Products.Item(i).Name
Set Position1 = Main_Product.Products.Item(i).Position
Call Position1.GetComponents(AxisComponentsArray)

Tab_Result(i, 1) = Instance_Name
Tab_Result(i, 2) = AxisComponentsArray(0)
Tab_Result(i, 3) = AxisComponentsArray(1)
Tab_Result(i, 4) = AxisComponentsArray(2)
Tab_Result(i, 5) = AxisComponentsArray(3)
Tab_Result(i, 6) = AxisComponentsArray(4)
Tab_Result(i, 7) = AxisComponentsArray(5)
Tab_Result(i, 8) = AxisComponentsArray(6)
Tab_Result(i, 9) = AxisComponentsArray(7)
Tab_Result(i, 10) = AxisComponentsArray(8)
Tab_Result(i, 11) = AxisComponentsArray(9)
Tab_Result(i, 12) = AxisComponentsArray(10)
Tab_Result(i, 13) = AxisComponentsArray(11)

End Sub

Could you help me with this ? this code is not working

 

[JordanCaron]

I have also this code in CATVBA that will display the mass and the point of inertia of a product.
But I need the point of inertia of each CATPART ...

Could you help me to compile such a code ?

Sub CATMain()

' Retrieve the selected component

Dim oSelection As Selection

Set oSelection = CATIA.ActiveDocument.Selection

Dim oProduct As AnyObject

On Error Resume Next

Set oProduct = oSelection.FindObject("CATIAProduct")

If (Err.Number <> 0) Then

MsgBox "No selected product"

Else

On Error GoTo 0

' Compute the inertia

Dim oInertia As AnyObject

Set oInertia = oProduct.GetTechnologicalObject("Inertia")

' Read the inertia data

Dim dMass As Double

dMass = oInertia.Mass

Dim dCoordinates(2)

oInertia.GetCOGPosition dCoordinates



' Display the results

MsgBox oProduct.Name & ": Mass = " & CStr(dMass) & ", Center of gravity : X = " & _

CStr(dCoordinates(0)) & ", Y = " + CStr(dCoordinates(1)) & ", Z = " + CStr(dCoordinates(2))

End If

End Sub

 

[LWolf]

your step2 code needs end of the for loop...
so just write "next" before the "End Sub" line

regards,
LWolf

 

[LWolf]

Sub Main()

Dim Main_Product As Product
Set Main_Product = CATIA.ActiveDocument.Product
Dim position1
Dim AxisComponentsArray(11)

Dim k As Integer
k = Main_Product.Products.Count
ReDim Tab_Result(1 To k, 1 To 13)

For i = 1 To Main_Product.Products.Count

Instance_Name = Main_Product.Products.item(i).name
Set position1 = Main_Product.Products.item(i).Position
position1.GetComponents AxisComponentsArray

Tab_Result(i, 1) = Instance_Name
Tab_Result(i, 2) = AxisComponentsArray(0)
Tab_Result(i, 3) = AxisComponentsArray(1)
Tab_Result(i, 4) = AxisComponentsArray(2)
Tab_Result(i, 5) = AxisComponentsArray(3)
Tab_Result(i, 6) = AxisComponentsArray(4)
Tab_Result(i, 7) = AxisComponentsArray(5)
Tab_Result(i, 8) = AxisComponentsArray(6)
Tab_Result(i, 9) = AxisComponentsArray(7)
Tab_Result(i, 10) = AxisComponentsArray(8)
Tab_Result(i, 11) = AxisComponentsArray(9)
Tab_Result(i, 12) = AxisComponentsArray(10)
Tab_Result(i, 13) = AxisComponentsArray(11)​

Next

End Sub

regards,
LWolf