1つのPartからBody毎にしたProductを作り出す

ﾀｲﾄﾙの日本語が怪しいのですが、要はこちらのｺﾏﾝﾄﾞで
Assy　→　Part　にしたものを、再度Assy状態にしたい　と言うことです。

このｺﾏﾝﾄﾞは古いﾘﾘｰｽでは表側に無く、裏ｺﾏﾝﾄﾞだったんですよね。
"ﾃﾞｰﾀを軽くして客先に支給したい" "ﾉｳﾊｳの流出防止の為"　等
ｲﾛｲﾛと理由はあるかと思いますが、少なくても干渉ﾁｪｯｸは
Assy状態の方が楽ですね。

で、Part→Productにする為のﾏｸﾛは、恐らく世間にもあると思います。
が、Freeであるものかどうかは不明です。
(僕は見つけられませんでした)

ﾎﾞﾃﾞｨだけですが、ﾏｸﾛを作ってみました。

'vba
'PartからProductﾃｽﾄ

Option Explicit

Sub CATMain()
    Dim ActDoc As PartDocument
    Set ActDoc = CATIA.ActiveDocument
    
    Dim ActPath As Variant
    ActPath = Array(ActDoc.FullName)
    
    Dim TopDoc As ProductDocument
    Set TopDoc = CATIA.Documents.Add("Product")
    
    Dim Prods As Products
    Set Prods = TopDoc.Product.Products
    
    Dim Sel As Selection
    Set Sel = TopDoc.Selection
    
    Dim BeforePDoc As PartDocument
    Set BeforePDoc = Include_Part(Prods, ActPath)
    
    Dim Pt As Part
    Set Pt = BeforePDoc.Part
    
    Dim LeafBodies As Collection
    Set LeafBodies = Get_LeafBodyLst(Pt.Bodies)
    
    Dim Bdy As Body
    Dim NewPDoc As PartDocument
    For Each Bdy In LeafBodies
        Set NewPDoc = Init_Part(Prods, Bdy.Name)
        With Sel
            .Clear
            .Add Bdy
            .Copy
            .Clear
            .Add NewPDoc.Part
            .PasteSpecial "CATPrtResultWithOutLink" '"CATPrtResult"
        End With
        NewPDoc.Part.Update
    Next
    
    With Sel
        .Clear
        .Add Prods.Item(1)
        .Delete
    End With
End Sub

'ﾙｰﾄで空ではないﾎﾞﾃﾞｨ取得
Private Function Get_LeafBodyLst(ByRef Bdys As Bodies) As Collection
    Set Get_LeafBodyLst = Nothing
    Dim Bdy As Body
    Dim Lst As Collection: Set Lst = New Collection
    For Each Bdy In Bdys
        If Bdy.InBooleanOperation = False And Bdy.Shapes.Count > 0 Then
            Lst.Add Bdy
        End If
    Next
    If Lst.Count < 1 Then Exit Function
    Set Get_LeafBodyLst = Lst
End Function

Private Function Init_Part(ByRef Prods As Variant, _
                           ByVal PtNum As String) As PartDocument
    Call Prods.AddNewComponent("Part", PtNum)
    Set Init_Part = Prods.Item(Prods.Count).ReferenceProduct.Parent
End Function

Private Function Include_Part(ByRef Prods As Variant, _
                              ByVal Path As Variant) As PartDocument
    Call Prods.AddComponentsFromFiles(Path, "All")
    Set Include_Part = Prods.Item(Prods.Count).ReferenceProduct.Parent
End Function