Macros VBA x Catia V5 .cat VBA

Le 10/07/2025 à 17:48

Bonjour à tous,

Je jette une bouteille à la mer car je suis à bout d'idées pour résoudre mon soucis.

Je travaille sur Catia V5, j'ai des points de perçages à extraire de la maquette sous format Excel.

J'ai une macro .catvba me permettant de créer les points au centre des trous de perçages.

Sub CreatePointInPLT300()
Dim catDoc As PartDocument
Dim oPart As Part
Dim geoSets As HybridBodies
Dim geoSetPLT300 As HybridBody
Dim newPoint As HybridShapePointCoord

' Récupérer le document actif et la pièce
Set catDoc = CATIA.ActiveDocument
Set oPart = catDoc.Part

' Récupérer la collection des HybridBodies
Set geoSets = oPart.HybridBodies

' Trouver le set "PLT300"
On Error Resume Next
Set geoSetPLT300 = geoSets.Item("PLT300")
On Error GoTo 0

If geoSetPLT300 Is Nothing Then
MsgBox "Le set PLT300 n'existe pas dans cette pièce."
Exit Sub
End If

' Créer un nouveau point coordonné dans le set PLT300
Set newPoint = oPart.HybridShapeFactory.AddNewPointCoord(-80, 0, 0)
newPoint.Name = "P3"

' Ajouter le point au set PLT300
geoSetPLT300.AppendHybridShape newPoint

' Mettre à jour la pièce pour appliquer les changements
oPart.Update

MsgBox "Point P1 créé avec succès dans PLT300."
End Sub

Et une autre macro .catvba qui devrait me permettre d'extraire les coordonnées de ces points et de me les mettre dans un tableau Excel.

Sub ExportPiedFP()
Dim catDoc As Document
Dim rootProd As Product
Dim xlApp As Object, xlBook As Object, xlSheet As Object
Dim row As Long

' Récupérer le document CATIA actif
Set catDoc = CATIA.ActiveDocument
Set rootProd = catDoc.Product

' Ouvrir Excel
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Sheets(1)

' Entête Excel
xlSheet.Cells(1, 1).Value = "Produit"
xlSheet.Cells(1, 2).Value = "Point"
xlSheet.Cells(1, 3).Value = "X"
xlSheet.Cells(1, 4).Value = "Y"
xlSheet.Cells(1, 5).Value = "Z"

row = 2

MsgBox "Début du parcours récursif..."

' Lancer le parcours complet des produits
ProcessProductsRecursively rootProd, xlSheet, row

MsgBox "Export terminé !"
End Sub

Sub ProcessProductsRecursively(oProd As Product, ws As Object, ByRef row As Long)
Dim childProd As Product
Dim products As products

' Si le produit contient "Pieds_FP_renforce", on l’exporte
If InStr(oProd.Name, "Pieds_FP_renforce") > 0 Then
'MsgBox "Produit Pieds_FP_renforce trouvé : " & oProd.Name
ProcessProduct oProd, ws, row
End If

' Parcourir les produits enfants s’il y en a
Set products = oProd.products
If Not products Is Nothing Then
For Each childProd In products
ProcessProductsRecursively childProd, ws, row
Next
End If
End Sub
Function GetDocumentFromProduct(oProd As Product) As Document
On Error Resume Next
Set GetDocumentFromProduct = CATIA.Documents.Item(oProd.ReferenceProduct.Parent.Name)
If GetDocumentFromProduct Is Nothing Then
' Si le produit est un document lui-même (part, product)
Set GetDocumentFromProduct = CATIA.Documents.Item(oProd.Name & ".CATPart")
If GetDocumentFromProduct Is Nothing Then
Set GetDocumentFromProduct = CATIA.Documents.Item(oProd.Name & ".CATProduct")
End If
End If
On Error GoTo 0
End Function

Sub ProcessProduct(oProd As Product, ws As Object, ByRef row As Long)
Dim partDoc As Document
Dim oPart As Part
Dim geoSets As HybridBodies
Dim geoSet As HybridBody
Dim element As HybridShape
Dim coords As Variant
Dim pt3D As Point
Dim foundPLT As Boolean

Set partDoc = GetDocumentFromProduct(oProd)
If partDoc Is Nothing Then
Debug.Print "PartDocument introuvable pour " & oProd.Name
Exit Sub
End If

Set oPart = partDoc.Part
Set geoSets = oPart.HybridBodies

If geoSets Is Nothing Then
Debug.Print "Aucun HybridBodies dans " & oProd.Name
Exit Sub
End If

foundPLT = False
For Each geoSet In geoSets
If geoSet.Name = "PLT300" Then
foundPLT = True
Exit For
End If
Next

If Not foundPLT Then
Debug.Print "Set PLT300 non trouvé dans " & oProd.Name
Exit Sub
Else
Debug.Print "Set PLT300 trouvé dans " & oProd.Name & " avec " & geoSet.HybridShapes.Count & " éléments"
End If

For Each element In geoSet.HybridShapes
Debug.Print "Type élément: " & typeName(element) & ", Nom: " & element.Name
Next

For Each element In geoSet.HybridShapes
Select Case typeName(element)
Case "HybridShapePointCoord", "HybridShapePointExplicit"
coords = element.Coordinates
Debug.Print element.Name & " : X=" & coords(0) & ", Y=" & coords(1) & ", Z=" & coords(2)
ws.Cells(row, 1).Value = oProd.Name
ws.Cells(row, 2).Value = element.Name
ws.Cells(row, 3).Value = coords(0)
ws.Cells(row, 4).Value = coords(1)
ws.Cells(row, 5).Value = coords(2)
row = row + 1

Case "HybridShapePointTangent"
On Error Resume Next
Set pt3D = element.GetPoint()
On Error GoTo 0
If Not pt3D Is Nothing Then
Debug.Print element.Name & " : X=" & pt3D.X & ", Y=" & pt3D.Y & ", Z=" & pt3D.Z
ws.Cells(row, 1).Value = oProd.Name
ws.Cells(row, 2).Value = element.Name
ws.Cells(row, 3).Value = pt3D.X
ws.Cells(row, 4).Value = pt3D.Y
ws.Cells(row, 5).Value = pt3D.Z
row = row + 1
Else
Debug.Print "Impossible de récupérer le point 3D pour " & element.Name
End If

Case Else
' autres types ignorés
End Select
Next

End Sub

edit modération : macros mis entre balises code </>. Merci d'y penser à l'avenir.

Le soucis dans cette deuxième macro est que les coordonnées ne peuvent être extrait car les points sont des "HybridShapePointTangent". Il est compliqué d'extraire les coordonnées de ce type de point.

Je ne comprends pas pourquoi mes points sont de ce type car ils sont créés à partir de coordonnées et non pas à partir d'objet ou autre.

Je cherche à avoir des points soit "HybridShapePointCoord", soit "HybridShapePointExplicit".

J'ai essayé de rentrer manuellement mes points pour avoir des "HybridShapePointCoord" mais rien n'y fait.

Si vous avez des idées, n'hésitez pas,

J'espère avoir été claire,

En vous remerciant par avance,

Bonne fin de journée !

Le 10/07/2025 à 18:08

Bonjour,

Merci de modifier votre message en mettant le code entre balises en cliquant sur </>

Jean-Paul.

Le 11/07/2025 à 09:38

Bonjour,

Avant toute chose, je n'ai jamais travaillé avec l'API Catia pour VBA et donc je ne peux que te donner des hypothèses, en espérant qu'elles puissent te debloquer.

D'abord, j'ai lu dans la doc que le problème pourrait venir du fait que la méthode AddNewPointCoord te renvoit un point paramétrique, et non un point fixe. Dans le sens où il depend de la géométrie de ton objet (Part) et non de l'assemblage total (Product) et donc tu pourrais avoir des offset entre la creation du point et sa lecture. Après apparemment ce n'est pas problématique pour toi.

Dans ce cas, si le seul soucis c'est l'utilisation des HybridShapePointTangent, tu peux le faire en quelques étapes avec l'outil de mesure de la Workbench :

' Code en partie généré par IA (Google Gemini) // A tester
Public Function GetPointCoordinates(ByVal oPointShape As HybridShape) As Variant
    ' Renvoie un tableau Variant(0 To 2) avec les coordonnées X, Y, Z
    ' Renvoie la valeur Empty en cas d'erreur

    On Error GoTo ErrorHandler

    ' 1. Obtenir la Part parente directement depuis l'objet
    Dim oParentPart As Part
    Set oParentPart = oPointShape.Parent.Parent ' HybridShape -> Parent (HybridBody) -> Parent (Part)

    ' 2. Obtenir le Workbench de mesure via la Part
    Dim oSPAWorkbench As Workbench
    ' HybridShape -> Parent (HybridBody) -> Parent (Part) -> Parent (Document)
    Set oSPAWorkbench = oParentPart.Parent.GetWorkbench("SPAWorkbench")

    ' 3. Créer la référence de l'objet (le point) a calculer
    Dim oReference As Reference
    Set oReference = oParentPart.CreateReferenceFromObject(oPointShape)

    ' 4. Mesurer et extraire les coordonnées
    Dim oMeasurable As Measurable, dCoords(0 To 2) As Double
    Set oMeasurable = oSPAWorkbench.GetMeasurable(oReference)
    oMeasurable.GetPoint dCoords

    ' 5. Assigner le tableau au résultat de la fonction
    GetPointCoordinates = dCoords

    Exit Function

ErrorHandler:
    ' En cas d'erreur (ex: l'objet n'est pas un point), renvoyer Empty
    GetPointCoordinates = Empty
End Function

Je t'ai mis comme paramètre un HybridShape car c'est la classe mère, et en théorie le code devrait ainsi fonctionner pour les HybridShapePointTangent mais aussi HybridShapePointOnCurve, HybridShapePointCenter etc.

Tu peux ainsi appeler cette fonction dans ton code quand tu tombes sur un point paramétrique pour en extraire ses coordonnées.

Le 11/07/2025 à 11:29

Bonjour,

C'est quand même dingue les gens qui sont inscrits depuis des lustres...
et qui ne savent toujours pas qu'il faut mettre le code entre balises

Non mais sérieux !

Le 11/07/2025 à 11:41

Bonjour,

Merci Saboh, je vais essayer d'intégrer ça,

J'ai continué mon enquête, dans ma macro qui place les points dans mon .CATPart, mes points sont bien des "HybridShapePointCoord".

Quand je passe dans mon produit, ils deviennent des "HybridShapePointTangent".

Belle journée !

Le 11/07/2025 à 11:43

Bonjour JEcxcel2fr,

C'est fou de ne pas être plus aimable après tant de messages postés.

Sur ce bonne continuation,

Le 11/07/2025 à 14:35
1000K a écrit :

Bonjour,

Merci Saboh, je vais essayer d'intégrer ça,

J'ai continué mon enquête, dans ma macro qui place les points dans mon .CATPart, mes points sont bien des "HybridShapePointCoord".

Quand je passe dans mon produit, ils deviennent des "HybridShapePointTangent".

Belle journée !

C'est donc une sorte de question liée au changement de référentiel. Intéressant. Le problème est-il résolu ?

Le 12/07/2025 à 11:50

@1000K

1000K a écrit :

Bonjour JEcxcel2fr,

C'est fou de ne pas être plus aimable après tant de messages postés.

Sur ce bonne continuation,

Je ne suis aimable qu'avec les gens qui respectent les règles et qui savent lire les chartes

Mais tu as raison, reste dans ton petit monde de dessinateurs en CAO

Le 21/07/2025 à 09:36

Bonjour Saboh,

J'ai du passer par un référentiel de transition sur ton idée de macro.

Merci pour ton aide,

Bonne journée !

Le 21/07/2025 à 09:40

@JExceL2fr

Mais quelle fermeture d'esprit,

Je note que vous vous donnez du mal en venant sur mon topic pour répondre pleurnicher.
Je plains votre équipe si vous êtes un manager aussi dénigreur.

Rechercher des sujets similaires à "macros vba catia cat"