How to fastly copy multiple partbody to existing product as a part?

[blackeng1660]

I always copy-paste to paste my partbodies into new created part.
How to copy multiple partbody to existing product as a part?
There is another macro for that?

 

[LWolf]

so you have multiple loose bodies in your part that you want to create parts of?... a part can/has only one PartBody, the others are called Body.1, Body.2 etc...
yes, write a macro for that purpose... it is fairly straight-forward

regards,
LWolf

 

[Maddy02]

This is in Reference to Post

https://www.eng-tips.com/viewthread.cfm?qid=452004

"How to copy multiple partbody to existing product as a part?"
I Suppose you need to copy each and every body as a part into a product..
if so, may be you can use below Code....

Sub CATMain()
    '------------------------------------------------------------------------------------------
    Dim oSourceDocument As PartDocument
    Dim oSourceDocumentWindow As Window
    Dim oTargetAssemblyProductDocument As ProductDocument
    Dim oTargetAssemblyRootProduct As Product
    Dim oTargetAssemblyWindow As Window
    Dim oSourcePart As Part
    Dim oBodyToCopy As Body
    Dim nameLength As Long
    Dim vBody As Variant
    Dim bCopy As Boolean
    '------------------------------------------------------------------------------------------
    bCopyBodiesUsedInBoolean = False
'    bCopyBodiesUsedInBoolean = True
    '------------------------------------------------------------------------------------------
    Set oSourceDocument = CATIA.ActiveDocument
    Set oSourceDocumentWindow = GetWindowByname(oSourceDocument.Name)
    '------------------------------------------------------------------------------------------
    Set oTargetAssemblyProductDocument = CATIA.Documents.Add("Product")
    Set oTargetAssemblyRootProduct = oTargetAssemblyProductDocument.Product
    '------------------------------------------------------------------------------------------
    Call oTargetAssemblyRootProduct.ApplyWorkMode(DESIGN_MODE) ' Make sure Design Mode is Applied
    '------------------------------------------------------------------------------------------
    Set oTargetAssemblyWindow = CATIA.Windows.item(CATIA.Windows.Count) ' As this will be the Last Window
    ' or
    'Set oSourceDocumentWindow = GetWindowByname(oTargetAssemblyProductDocument.Name)
    '------------------------------------------------------------------------------------------
    Call CATIA.Windows.Arrange(catArrangeTiledVertical)
    '------------------------------------------------------------------------------------------
    partName = oSourceDocument.Name
    nameLength = InStr(1, partName, ".CATPart")
    oTargetAssemblyRootProduct.PartNumber = Mid(partName, 1, nameLength - 1)
    '------------------------------------------------------------------------------------------
    'oSourceDocumentWindow.Activate 'Not Required To Activate
    '------------------------------------------------------------------------------------------
    Set oSourcePart = oSourceDocument.Part
    '------------------------------------------------------------------------------------------
    For Each vBody In oSourcePart.Bodies
        '------------------------------------------------------------------------------------------
        Set oBodyToCopy = vBody
        '------------------------------------------------------------------------------------------
        bCopy = False
        bCopy = CBool(CStr(oBodyToCopy.InBooleanOperation) = "False") Or bCopy
        bCopy = CBool(CBool(CStr(oBodyToCopy.InBooleanOperation) = "True") And bCopyBodiesUsedInBoolean) Or bCopy
        '------------------------------------------------------------------------------------------
        If bCopy Then
            '------------------------------------------------------------------------------------------
            Dim newProductInTargetAssembly As Product
            Set newProductInTargetAssembly = oTargetAssemblyRootProduct.Products.AddNewComponent("Part", oBodyToCopy.Name)
            Set oTargetDocumentPart = newProductInTargetAssembly.ReferenceProduct.Parent.Part
            '------------------------------------------------------------------------------------------
            'Copy Body from SourceDocument
            '------------------------------------------------------------------------------------------
            Call oSourceDocument.Selection.Clear
            Call oSourceDocument.Selection.Add(oBodyToCopy)
            Call oSourceDocument.Selection.Copy
            '------------------------------------------------------------------------------------------
            ' First select the new PartDocument Added
            Call oTargetAssemblyProductDocument.Selection.Clear
            Call oTargetAssemblyProductDocument.Selection.Add(oTargetDocumentPart)
            '------------------------------------------------------------------------------------------
            ' Paste the Body in the new PartDocument Added
            Call oTargetAssemblyProductDocument.Selection.PasteSpecial("CATPrtResult")
            '------------------------------------------------------------------------------------------
            Call oTargetAssemblyProductDocument.Selection.Clear
            Call oTargetDocumentPart.Update
            Call newProductInTargetAssembly.Update
            '------------------------------------------------------------------------------------------
        End If
    Next
    '------------------------------------------------------------------------------------------
    Call oSourceDocument.Selection.Clear
    Call oTargetAssemblyProductDocument.Selection.Clear
    '------------------------------------------------------------------------------------------
    '------------------------------------------------------------------------------------------
    oTargetAssemblyWindow.WindowState = catWindowStateMaximized
    Call oTargetAssemblyRootProduct.Update
    Call oTargetAssemblyWindow.ActiveViewer.Reframe
    Call oTargetAssemblyWindow.Activate
    '------------------------------------------------------------------------------------------
End Sub

Private Function GetWindowByname(ByVal nameOfWindowToSearch As String)
    Dim oFoundWindow As Window
    '------------------------------------------------------------------------------------------
    Set oFoundWindow = Nothing
    '------------------------------------------------------------------------------------------
    On Error Resume Next
    Set oFoundWindow = CATIA.Windows.GetItem(nameOfWindowToSearch)
    On Error GoTo 0
    '------------------------------------------------------------------------------------------
    If (oFoundWindow Is Nothing) Then
        For Each vWindow In CATIA.Windows
            Debug.Print vWindow.Name
            If (vWindow.Name = nameOfWindowToSearch) Then
                Set oFoundWindow = vWindow
                Exit For
            End If
        Next
    End If
    '------------------------------------------------------------------------------------------
    Set GetWindowByname = oFoundWindow
    '------------------------------------------------------------------------------------------
End Function

Regards,
Maddy