Code:
Sub CATMain()
On Error Resume NextDim objExcel As Object
Dim strExcelPfad As String
Dim doc As Document
Dim ProdWurzel As Product
Dim intLetzteZeile As Integer
Set doc = CATIA.ActiveDocument
'Prüfung, ob ein Produkt in Catia geladen ist
If doc Is Nothing Then
MsgBox "Bitte ERST ein Produkt laden - DANN dieses Makro neustarten!"
Return
End If
Set ProdWurzel = doc.Product
'Funktionsaufruf um die Struktur auszulesen
BaumDurchlaufen ProdWurzel, 0, objExcel, intLetzteZeile
MsgBox "FERTIG!"
End Sub
____________________________________________________________________________________________________________________________________________
Sub BaumDurchlaufen(prod As Product, p_intEbene As Integer, Excel As Object, intLetzteZeile As Integer)
On Error Resume Next
Dim strZeichen As Integer
Dim ProdChildren As Products
Dim i As Integer
Dim ProdChild As Product
Dim strNumber As String
Dim intZaehler As Integer
Dim intPosArr(11)
Dim objChildren As Product
Dim objPosition As Object
Dim strDescrRef As String
Dim strQuelle As String
Dim strVersion As String
Dim strDefinition As String
Set ProdChildren = prod.Products
Set objChildren = ProdChildren.Item(ProdChildren.Count)
Set objPosition = objChildren.Position
'Transformationsmatrix auslesen
objPosition.GetComponents intPosArr
For intZaehler = 0 To p_intEbene
strZeichen = strZeichen + 1
Next
'Informationen aller Objekte eines Astes des Strukturbaums auslesen
For i = 1 To ProdChildren.Count
Set ProdChild = ProdChildren.Item(i)
strQuelle = ProdChild.Nomenclature
strVersion = ProdChild.Revision
strDefinition = ProdChild.Definition
strNumber = ProdChild.Name
strNumber = Left(strNumber, InStr(strNumber, "_") - 1)
'Excel-Liste füllen
'Rekursion
BaumDurchlaufen ProdChild, p_intEbene + 1, Excel, intLetzteZeile
Next i
End Sub