0

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
Mayukh Bhattacharya
  • 12,541
  • 5
  • 21
  • 32
Rom1_ C.
  • 1
  • 1
  • If you had axissystems in hybrid bodies you could to use _selection.search_ to get them. But you can only get the coordinates and orientation to the origin of the part. Maybe searching for all axissystems in the rootproduct and measure them is easier. – Shrotter Jul 25 '23 at 14:09

0 Answers0