Eng-Tips is the largest engineering community on the Internet

Intelligent Work Forums for Engineering Professionals

  • Congratulations waross on being selected by the Eng-Tips community for having the most helpful posts in the forums last week. Way to Go!

[CATIA macro VBA] Copy body and paste it in new part

Status
Not open for further replies.

marusic

Mechanical
Apr 24, 2019
1
HR
Hi everyone,

I am new to macro programming maybe 2 weeks in it and I just tried to write something.
Idea is to make macro that will move all bodies from part to new parts in new product.
I have seen this on forums but I couldn't make code work so i started from beginning.

Here is my code so far, I got to pasting body to new part:

Code:
Sub CATMain()

    '--------- NEW PRODUCT ---------
    '----- named as start part -----

        partName = CATIA.ActiveDocument.Name

    Dim doc As Documents
    Set doc = CATIA.Documents

    Dim docProduct As Document
    Set docProduct = doc.Add("Product")

    Dim newProduct As Product
    Set newProduct = docProduct.Product
    
    Dim nameLength As Long
    
        nameLength = InStr(1, partName, ".CATPart")
        newProduct.PartNumber = Mid(partName, 1, nameLength - 1)
        

    '----- RETURN PART WINDOW ------
            
    Dim partWindow As Window
    Set partWindow = CATIA.Windows.Item(1)
        partWindow.Activate
    
    
    '---- COPY BODIES TO PARTS ----
    
    Dim inPart As PartDocument
    Set inPart = CATIA.ActiveDocument
           
    Dim bodyNumber As Integer
        bodyNumber = inPart.Part.Bodies.Count
    
    Dim body1 As Object
    Dim bodyName As String
               
    For i = 1 To bodyNumber
        Set body1 = inPart.Part.Bodies.Item(i)
            bodyName = body1.Name
        
        Dim newPart As Product
        [b]Set newPart = newProduct.Products.AddNewComponent("Part", bodyName)[/b]
        
        inPart.Selection.Clear
        inPart.Selection.Add body1
        inPart.Selection.Copy
        inPart.Selection.PasteSpecial ("CATPrtResult")
        
        newProduct.Parent.Activate
        newProduct.Parent.Selection.Clear
        newProduct.Parent.Selection.Add body1
        newProduct.Parent.Selection.PasteSpecial ("CATPrtResult")
       
        Next
    
    newProduct.Update

End Sub

EDIT:
I managed to run it. Problems are:
1. Bodies are pasting in the same part (from which I want to make product). Don't know how to paste them in new part.
2. After 7-8 loops it shows error (bolded line in code):
Run-time error '-2147467259(80004005)':
Method 'AddNewComponent' of object 'Products' failed


Please help.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top