CATIA Part_to_Product CATScript

Dim i n As Integer

Dim name prt As String

Dim BodyName() As String

Dim partDocument1 As PartDocument

On Error Resume Next

Set partDocument1 = CATIA.ActiveDocument

    If Err.Descxxxxription = "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

    ReDim Preserve BodyName(i)

    BodyName(i) = prt & "_" & bodies1.Item(i).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

    sel.Add part2

    sel.PasteSpecial ("CATPrtResultWithOutlixxxxnk")

    part2.Update

    Set partDocument2 = CATIA.ActiveDocument

    partDocument2.SaveAs Left(name Len(name) - Len(partDocument1.name)) & BodyName(i) & ".CATPart"

    specsAndGeomWindow1.Close

    partDocument2.Close

Next 'i

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

For i = 1 To n

    ConString = ""

    ConString = "Product_From_Part_" & prt & "/" & BodyName(i) & ".1/!" & "Product_From_Part_" & 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 'i

End Sub