To loop through the content of an assembly you can use programming technique called recursion. Recursion is a powerful concept where a procedure calls itself. Although it is not the most effective way how to write a code, there are cases when advantages of this technique overweight its drawbacks like higher memory usage or lower efficiency. Also, it is very important to design your recursive procedure to terminate the recursion properly otherwise you end up stuck in an infinite loop and Out of stack space error.
You can almost always substitute recursion for a loop!
Recursion - the right way
In the Main procedure, we define an empty variant array which is our container for an assembly content. As a container, we could have used also other data types like Collection or Dictionary, but unlike collections, arrays can be directly exported to an Excel worksheet.
For an initial call to a recursive subroutine, we need also a top assembly product stored in prod variable. Both variables are then passed as parameters to our recursive procedure ParseAssyTree. Procedure SimpleArrayToExcel is just a helper function responsible for an Excel export.
Option Explicit Sub Main() Dim prod As Product Dim bom() As Variant bom = Array() Set prod = CATIA.ActiveDocument.Product ' call to a recursive procedure ParseAssyTree prod, bom ' export an array to excel SimpleArrayToExcel bom End Sub ' recursive procedure Sub ParseAssyTree(currProduct As Variant, content(), Optional level As Long = 0) ReDim Preserve content(UBound(content) + 1) content(UBound(content)) = String(level, "!") & level & " " & currProduct.PartNumber & " : (" & currProduct.Name & ")" Dim curr As Variant For Each curr In currProduct.Products ParseAssyTree curr, content, level + 1 Next End Sub
Procedure ParseAssyTree has also an additional Optional argument called level. We use it to determine how deep we are immersed in a structure. On every recursive call, we resize an array by one with preserving its existing items. We then assign a string value which describes a current product to the last item of an array. In the following loop, we call our recursive procedure for every child of a current product with a level variable increased by one. A "terminal condition" is assured by currProduct.Products collection which is empty at the ends of a structure (usually CATIA Parts with no children) and therefore a procedure inside is not executed.
To get a nice indented Excel output we add at the beginning of every item in the content array a number of exclamation marks ("!") equal to the level variable. We use it later in SimpleArrayToExcel procedure.
Changes in a recursive procedure
We could change our recursive procedure to perform other actions than just getting a structure description. We could use it to get other properties of a product like parameters, position, weight or we could just rename nodes. We could use a Dictionary as a container for a structure to get a list of all unique items in our assembly together with their counts.
' export simple (one dimensional) array to Excel Sub SimpleArrayToExcel(simpleArr() As Variant) Const xlDelimited = 1 ' create excel object Dim xlApp As Object Set xlApp = CreateObject("Excel.Application") ' add workbook Dim wbook As Object Set wbook = xlApp.Workbooks.Add ' set copyTo range to the same size as array Dim copyTo As Object Set copyTo = wbook.Sheets(1).Range("B2").Resize(UBound(simpleArr) + 1, 1) ' copy content of array into excel range copyTo.Value = xlApp.Transpose(simpleArr) ' split text to columns by "!" character copyTo.TextToColumns Destination:=copyTo, DataType:=xlDelimited, Other:=True, OtherChar:="!" ' show excel xlApp.Visible = True End Sub
In the last part of a code, we export a structure to an Excel file. We define a procedure which takes a one-dimensional array as a parameter and export its content to a worksheet. In order to have a different indentation for product nodes based on a level, we split the text into separate columns with Excel function TextToColumns by "!" (exclamation mark) character as a delimiter. As a result, we get a worksheet with level based indentation as shown below.
Excel output sample
To test it copy all procedures into a standard module and launch Export sub.
Recursion - a wrong way
For those who are eager to see what happens when things go wrong look at the example below.
Option Explicit Sub RecursionTest() InfiniteLoop (0) End Sub Function InfiniteLoop(counter As Long) As Long counter = counter + 1 If counter Mod 1000 = 0 Then Debug.Print counter InfiniteLoop counter End Function
In this example, a terminal condition is not defined and our procedure gets trapped into an infinite loop. After a number of repetitions (in my case it was around six thousand), you get the following error message:
Out of stack space error in VBA