I want to get the information of axis systems inside multiple parts inside an assembly (recursive search). A part can have several axis systems, also in these geometric sets. It is necessary to have the positioning of the systems of axes compared to the main assembly. And put this information in an excel file.
My first try is to check the list of part (that is good to take it in excel file) But after i don't know how i can read the information of axis systems inside these parts.
Thanks for the help.
Sub CATMain()
Dim catApp As Object
Dim productDocument As Document
Dim RootProduct As product
Dim AssemDoc As Object
Dim fileName As String
Dim excelApp As Object
Dim excelWorkbook As Object
Dim excelWorksheet As Object
Dim row As Integer
' Vérifier si CATIA est ouvert
Set catApp = GetObject(, "CATIA.Application")
If catApp Is Nothing Then
MsgBox "CATIA n'est pas ouvert. Veuillez ouvrir CATIA avant d'exécuter cette macro.", vbExclamation
Exit Sub
End If
' Obtenir l'assemblage actif dans CATIA
Set AssemDoc = catApp.ActiveDocument
' Vérifier si un assemblage est actif
If Not TypeOf AssemDoc Is productDocument Then
MsgBox "Aucun assemblage actif n'est ouvert. Veuillez ouvrir un assemblage avant d'exécuter cette macro.", vbExclamation
Exit Sub
End If
' Récupérer le document produit actuellement ouvert
Set productDocument = CATIA.ActiveDocument
' Récupérer le produit racine
Set RootProduct = productDocument.product
' Créer une instance d'Excel
Set excelApp = CreateObject("Excel.Application")
' Créer un nouveau classeur Excel
Set excelWorkbook = excelApp.Workbooks.Add
' Sélectionner la première feuille
Set excelWorksheet = excelWorkbook.Sheets(1)
' Entête de colonne
excelWorksheet.Cells(1, 1).Value = "PartNumber"
excelWorksheet.Cells(1, 2).Value = "posX"
excelWorksheet.Cells(1, 3).Value = "posY"
excelWorksheet.Cells(1, 4).Value = "posZ"
excelWorksheet.Cells(1, 5).Value = "rotXX"
excelWorksheet.Cells(1, 6).Value = "rotXY"
excelWorksheet.Cells(1, 7).Value = "rotXZ"
excelWorksheet.Cells(1, 8).Value = "rotYX"
excelWorksheet.Cells(1, 9).Value = "rotYY"
excelWorksheet.Cells(1, 10).Value = "rotYZ"
excelWorksheet.Cells(1, 11).Value = "rotZX"
excelWorksheet.Cells(1, 12).Value = "rotZY"
excelWorksheet.Cells(1, 13).Value = "rotZZ"
' Ligne actuelle
row = 2
' Appeler la fonction récursive pour parcourir les pièces
ProcessProduct RootProduct, excelWorksheet, row
' Enregistrer le classeur Excel
fileName = "C:\Users\rchelmas\Documents\chemin_vers_le_fichier_excel.xlsx"
excelWorkbook.SaveAs fileName
' Fermer le classeur Excel
excelWorkbook.Close
' Fermer l'application Excel
excelApp.Quit
' Libérer les objets Excel
Set excelWorksheet = Nothing
Set excelWorkbook = Nothing
Set excelApp = Nothing
MsgBox "Les données des matrices de position ont été exportées vers Excel avec succès.", vbInformation
End Sub
Sub ProcessProduct(ByVal product As product, ByVal excelWorksheet As Object, ByRef row As Integer)
Dim part As product
' Parcourir les sous-produits du produit actuel
For Each part In product.Products
' Récupérer les valeurs individuelles de la matrice de positionnement
Dim oAxisComponentsArray(11) 'As Double
Dim posX As Double
Dim posY As Double
Dim posZ As Double
Dim rotXX As Double
Dim rotXY As Double
Dim rotXZ As Double
Dim rotYX As Double
Dim rotYY As Double
Dim rotYZ As Double
Dim rotZX As Double
Dim rotZY As Double
Dim rotZZ As Double
posX = oAxisComponentsArray(0)
posY = oAxisComponentsArray(1)
posZ = oAxisComponentsArray(2)
rotXX = oAxisComponentsArray(3)
rotXY = oAxisComponentsArray(4)
rotXZ = oAxisComponentsArray(5)
rotYX = oAxisComponentsArray(6)
rotYY = oAxisComponentsArray(7)
rotYZ = oAxisComponentsArray(8)
rotZX = oAxisComponentsArray(9)
rotZY = oAxisComponentsArray(10)
rotZZ = oAxisComponentsArray(11)
' Obtenir les composants de la matrice de position de la pièce
'art.Position.GetComponents oAxisComponentsArray -> Wrong way ??
' Numéro de pièce
excelWorksheet.Cells(row, 1).Value = part.PartNumber
excelWorksheet.Cells(row, 2).Value = posX
' Passer à la ligne suivante
row = row + 1
' Appeler récursivement ProcessProduct pour chaque sous-produit
ProcessProduct part, excelWorksheet, row
Next part
End Sub