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:
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.
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.