Copy-Paste over assembly macro

[mrawlinc]

Hi all!

I'm trying to code macro which would copy bodies from all parts and instances in assembly (1st level) and paste them (as result) in newly created part in same assembly.
Problem is that if I do the same thing manually, positions of fasted bodies are as in source part or instance, if I macro does it, positions of bodies form source are ok, but from instances are not.
I guess it should be pasted "in context", but how to do this with macro?

Sub CATMain()
    Dim RootProduct As Product
    Set RootProduct = CATIA.ActiveDocument.Product

    'first check if document is part or product
    If InStr(CATIA.ActiveDocument.name, ".CATProduct") < 1 Then
        MsgBox RootProduct.name & " NOT Assembly!"
    Exit Sub
    End If
    
    ' count of parts and instances to use
    Dim PartsCount As Integer
    PartsCount = RootProduct.Products.Count
    
    Debug.Print "Total numbers of parts:"; PartsCount
    
    'Enter name of new Part and name it
    Dim newPartName As String
    newPartName = InputBox("Enter name for new part.")
        
    Dim newPart As Product
    Set newPart = RootProduct.Products.AddNewComponent("Part", newPartName) 'create part to paste bodies in it
    
    Dim targetPart As Part
    Set targetPart = newPart.ReferenceProduct.Parent.Part
    
    ' loop trough parts
    Dim BodyCount As Integer
    Dim oPart As Part
    Dim curentBody As body
    Dim selectedEL As Selection
    Set selectedEL = CATIA.ActiveDocument.Selection
    Dim k As Integer
    Dim rndNo As Integer
    Dim m As Integer 'counter for pasted bodies
    
    m = 2
    
    ' loop trough parts and instances
    
    For i = 1 To PartsCount
        
        Set oPart = RootProduct.Products.Item(i).ReferenceProduct.Parent.Part
        
        ' Debug.Print oPart.name
        
        BodyCount = oPart.Bodies.Count
            
        ' Debug.Print BodyCount
        

        ' loop trough bodies

        For k = 1 To BodyCount
                
                
                Set curentBody = oPart.Bodies.Item(k)
                
                If curentBody.Shapes.Count > 0 Then 'check if body is empty

                    selectedEL.Clear
                    selectedEL.Add curentBody
                    selectedEL.Copy
                    selectedEL.Clear
                    selectedEL.Add targetPart
                    selectedEL.PasteSpecial ("CATPrtResultWithOutLink")
                    selectedEL.Clear
                
                    rndNo = (10000 * Rnd) 'generate random number for pasted body renaming
                
                    targetPart.Bodies.Item(m).name = targetPart.Bodies.Item(m).name & rndNo
                
                    m = m + 1
                
                Else
                
                Debug.Print curentBody.name & " is empty!"
                
                End If
                
             ' Debug.Print curentBody.name

        Next
            
        
            
    Next
Debug.Print m ' number of pasted bodies
newPart.Update
    

End Sub

 

[Little Cthulhu]

You know there's a built-in command "Convert to part" in Assembly Design workbench that does the same thing, don't you?

 

[mrawlinc]

Sure I know for Genreate CATPart from Product... command, problem is that it does not preserve colors of bodies or faces. If you do copy/paste "in context" it does preserve.

 

[Little Cthulhu]

Have you checked similar thread before starting a new one?