Option Explicit

Sub CATMain()
    Dim oActDoc As Document
    If CATIA.Documents.Count = 0 Then
        MsgBox ("Kein Dokument geöffnet!")
        Exit Sub
    End If
    Set oActDoc = CATIA.ActiveDocument
    If TypeName(oActDoc) <> "ProductDocument" Then
        MsgBox ("Kein Product geladen!")
        Exit Sub
    End If

    Dim oProduct As Product
    Set oProduct = oActDoc.Product
    Dim oProducts As Products
    Set oProducts = oProduct.Products

    'Um die Struktur nachzubauen
    'müsstest du hier den neuen Root erzeugen und auch die Subroutine übergeben

    'Rekursiv durch den Baum gehen, 1. Ebene
    RekursivDurchBaum oProducts, oProduct, 1

End Sub

Function RekursivDurchBaum(oProducts As Products, oRoot As Product, iLevel As Integer)
    Dim oProduct As Product
    Dim oRefProduct As Product
    Dim oRefDocument As Document
    Dim oProductVariant

    Dim aPositionToRoot(11)
    Dim positionToFather(11)

    
    For Each oProduct In oProducts
        'egal, ob du an einen Part oder Product bist, hier ist
        Set oProductVariant = oProduct 'nur wegen VBA notwendig
        oProductVariant.position.GetComponents positionToFather 'Transformation von Elternteil
        MatrixPrint "Position to Father from " & oProduct.Name, positionToFather
        
        GetAbsPosition oProduct, oRoot, aPositionToRoot 'Transformation von Root
        MatrixPrint "Position to Root from " & oProduct.Name, aPositionToRoot
        
        'PartNumber
        Debug.Print iLevel, oProduct.PartNumber
        'InstanceName
        Debug.Print oProduct.Name
        
        Set oRefProduct = oProduct.ReferenceProduct
        Set oRefDocument = oRefProduct.Parent
        'FileName
        Debug.Print oRefDocument.Name
        
        If oProduct.Products.Count > 0 Then
        
            'Um die Struktur nachzubauen müsstest du hier
            'einen neuen Product erzeugen,
            'es den übergegebenen Root anfügen
            'Transformation von Elternteil mit .Move.Apply anwenden
            'neuen Product als Root für die nächste Ebene übergeben
            'ggf. umbenennen
            'ggf. wenn die gewünschte Tiefe (Wert von iLevel) erreicht ist,
            '     gleich ein .cgr erzeugen und und hier einfügen
        
            'Rekursiv durch den Baum gehen, nächste Ebene
            RekursivDurchBaum oProduct.Products, oRoot, iLevel + 1
        Else
            'Zweig hat keine Kinder, ist eigentlich ein Blatt
            
            'Um die Struktur nachzubauen müsstest du hier
            'einen cgr von Originalpart (orefdocument) erzeugen,
            'es den übergegebenen Root anfügen
            'Transformation von Elternteil mit .Move.Apply anwenden
            'ggf. umbenennen
            
            If TypeName(oRefDocument) = "PartDocument" Then
    '          Du bist an einen Part

            End If
        End If
    Next
End Function

'Übernahme von CATIA
' ***********************************************************************
'   Purpose     : Copy and paste products while keeping their absolute position.
'   Assumptions : Products to copy/paste have to be selected.
'   Author      :
'   Languages   : VBScript
'   Locales     : English
'   CATIA Level : V5R7
' ***********************************************************************

' ***********************************************************************
'
' Purpose:  Define the product of two matrix.
'
' Inputs :  matrix1  Array       array corresponding to the first matrix
'           matrix2  Array       array corresponding to the second matrix
'
' Outputs:  res      Array       array corresponding to the product
'
' ***********************************************************************
Sub MatrixProduct(ByVal matrix1, ByVal matrix2, ByRef res)

    Dim a(11)
    Dim b(11)
    Dim I As Integer
    For I = 0 To 11
        a(I) = matrix1(I)
        b(I) = matrix2(I)
    Next

    res(0) = a(0) * b(0) + a(1) * b(3) + a(2) * b(6)
    res(3) = a(3) * b(0) + a(4) * b(3) + a(5) * b(6)
    res(6) = a(6) * b(0) + a(7) * b(3) + a(8) * b(6)
    res(1) = a(0) * b(1) + a(1) * b(4) + a(2) * b(7)
    res(4) = a(3) * b(1) + a(4) * b(4) + a(5) * b(7)
    res(7) = a(6) * b(1) + a(7) * b(4) + a(8) * b(7)
    res(2) = a(0) * b(2) + a(1) * b(5) + a(2) * b(8)
    res(5) = a(3) * b(2) + a(4) * b(5) + a(5) * b(8)
    res(8) = a(6) * b(2) + a(7) * b(5) + a(8) * b(8)
    res(9) = a(9) * b(0) + a(10) * b(3) + a(11) * b(6) + b(9)
    res(10) = a(9) * b(1) + a(10) * b(4) + a(11) * b(7) + b(10)
    res(11) = a(9) * b(2) + a(10) * b(5) + a(11) * b(8) + b(11)

End Sub

' ***********************************************************************
'
' Purpose:  Print the content of a matrix.
'
' Inputs :  sName    String      name of the matrix
'           matrix   Array       array corresponding to the matrix
'
' ***********************************************************************
Sub MatrixPrint(ByVal sName, ByVal matrix)

    Dim a(11)
    Dim I As Integer
    For I = 0 To 11
        If ((matrix(I) < 0.001) And (matrix(I) > -0.001)) Then
            a(I) = 0#
        Else
            a(I) = matrix(I)
        End If
    Next

    Dim sTemp As String
    sTemp = sName + " = " + _
            CStr(a(0)) + ",  " + CStr(a(1)) + ",  " + CStr(a(2)) + ",  " + CStr(a(3)) + ",  " + CStr(a(4)) + ",  " + CStr(a(5)) + ",  " + _
            CStr(a(6)) + ",  " + CStr(a(7)) + ",  " + CStr(a(8)) + ",  " + CStr(a(9)) + ",  " + CStr(a(10)) + ",  " + CStr(a(11))

    Debug.Print sTemp
End Sub

' ***********************************************************************
'
' Purpose:  Retrieve the absolute position of a product.
'
' Inputs :  oProduct Product     the product
'           oRoot    Product     the root product
'
' Outputs:  position Array       array corresponding to position of the product
'
' ***********************************************************************
Sub GetAbsPosition(ByRef oProduct, ByRef oRoot, ByRef position)

    If (oProduct.Name = oRoot.Name) Then
        position(0) = 1#
        position(1) = 0#
        position(2) = 0#
        position(3) = 0#
        position(4) = 1#
        position(5) = 0#
        position(6) = 0#
        position(7) = 0#
        position(8) = 1#
        position(9) = 0#
        position(10) = 0#
        position(11) = 0#
    Else
        Dim positionToFather(11)
        Dim fatherAbsolutePosition(11)
        oProduct.position.GetComponents positionToFather
        GetAbsPosition oProduct.Parent.Parent, oRoot, fatherAbsolutePosition
        MatrixProduct positionToFather, fatherAbsolutePosition, position
    End If

End Sub