Cycle through PPR tree Macro

[chrismech91]

Hi everyone,

I am looking for a macro that scans the PPR tree and writes down in a (dynamic) array the PARTS of a MAINPRODUCT.

My problem scenario is to move level by level all parts of the mainproduct but i want to do it through a dynamic array.

I made an attempt with a for loop in order to create the array and is the following:
---------------------------------------------------
Sub CATMain()

Set productDocument1 = CATIA.ActiveDocument

Set product1 = productDocument1.Product

Set products1 = product1.Products

Dim partcount As Integer
partcount=product1.Products.Count

msgbox "The number of parts is "&partcount&". Please click OK to continue."


Dim ObjArray(999) As Object

For i = 1 to partcount

Set ObjArray(i-1) = products1.Item(i)

'Set ObjArray(0) = products1.Item(1)
'Set ObjArray(1) = products1.Item(2)
'Set ObjArray(2) = products1.Item(3) 'At this case there are 6 parts
'Set ObjArray(3) = products1.Item(4)
'Set ObjArray(4) = products1.Item(5)
'Set ObjArray(5) = products1.Item(6)

Next

Set move1 = ObjArray(i=4).Move

Set move1 = move1.MovableObject

Dim arrayOfVariantOfDouble1(11)
arrayOfVariantOfDouble1(0) = 1.000000
arrayOfVariantOfDouble1(1) = 0.000000
arrayOfVariantOfDouble1(2) = 0.000000
arrayOfVariantOfDouble1(3) = 0.000000
arrayOfVariantOfDouble1(4) = 1.000000
arrayOfVariantOfDouble1(5) = 0.000000
arrayOfVariantOfDouble1(6) = 0.000000
arrayOfVariantOfDouble1(7) = 0.000000
arrayOfVariantOfDouble1(8) = 1.000000
arrayOfVariantOfDouble1(9) = 0.000000
arrayOfVariantOfDouble1(10) = 15.000000
arrayOfVariantOfDouble1(11) = 10.000000
move1.Apply arrayOfVariantOfDouble1

End Sub
------------------------------------------------

No matter what is the value at { Set move1 = ObjArray(i=4).Move } the result is to move always the first part.

I would be very pleased if you could suggest me a code or help me fix mine.

 

[lukaszsz]

Dim ObjArray(999) As AnyObject

or

Dim ObjArray(999) As Product

LukaszSz. Poland, Warsaw University of Technology, Faculty of Power and Aeronautical Engineering : MEchanical Engineering. BsC - 2013