Extraction de points d'esquisse

Salut tout le monde,

Je voudrais savoir s'il y avait un moyen d'extraire des points qui sont sur les esquisses.
Je m'explique: j'ai des tuyaux et je voudrais extraire les points de départ et de fin de ces tuyaux qui sont variables.



Je voulais savoir comment extraire ces points via une macro.
Je me doute qu'il va y avoir ce genre de lignes de commande:
Dim oPoint As GeometricElement
Sub GetCoordinates( CATSafeArrayVariant oPoint)
ou
objProduct.GetPointsOnCurve Coordinates

Une idée?

Salut Nicolas,

As tu essayé :

Code:

Language="VBSCRIPT"

Sub CATMain()

Set partDocument1 = CATIA.ActiveDocument
Set selection1 = partDocument1.Selection
selection1.Search " CATSketchSearch.2DPoint,all"

              msgbox "Nombre de point dans les esquisses :  " & selection1.count

'selection1.Clear

End Sub


Pour la suite ça dépend ce que tu veux exporter et vers où.

Salut Marc,

Non je n'ai pas essayé, le problème est que je souhaite extraire uniquement certains points de mon esquisse, pas tous, et malheureusement je n'ai aucune idée de comment automatiser la sélection de ces points précis (ces points précis étant les fins de tuyauteries, coudes et tés), pas seulement parce que je ne sais pas trop comment faire, mais également parce que je ne suis pas sûr que ces points seront toujours les points voulus.

De plus, les assemblages sur lesquels je bosse, sont des assemblages de 250+ pièces, je dois pouvoir extraire les infos nécessaires, rien de plus.

Je me demande si ce n'est pas possible de trouver ces points via les surface en fait, du genre coordonnées du centre de la surface que l'on va noter origine puis coordonnées de la 2e surface...

Salut Nicolas,

Il faut effectivement trouver un moyen de filtrer la sélection.

Il est possible de rechercher les cercles dans les esquisses et de récupérer les points des extrémités (comme sur ton image) : le problème est que l'on récupère des point 2D (uniquement coordonnées X,Y dans le plan de l'esquisse).

Est ce qu'il te faut des points 3D?
Les cercles à l'extrémité de tes raccords ont ils un nom particulier?

Tu programmes en VBA ou en VBScript?

Salut Marc,

J'ai eu de l'aide sur eng-tips.com et en fait j'ai changé la façon de faire: si je passe par les surface, je peux extraire les coordonnées du système général (dans ma 1ere idée, si j'extrayais les points d'esquisse, j'aurais récupéré uniquement en 2D et dans le référentiel esquisse, ce qui n'était pas mon objectif)
Voici le code utilisé

Code:

Sub CATMain()
    Dim doc, sel, spa, ref, measurable
    Dim inputObjectType(0)
    
    Set doc = CATIA.ActiveDocument
    Set sel = doc.selection
    Set spa = doc.GetWorkbench("SPAWorkbench")
 
    'Selection of circular edge
    inputObjectType(0) = "TriDimFeatEdge"
    Status = sel.SelectElement2(inputObjectType, "Select the edge", True)
    If (Status = "cancel") Then Exit Sub
        
    Set ref = sel.Item(1).Reference
    Set measurable = spa.GetMeasurable(ref)
    sel.Clear
    
    Dim Coordinates(2)
    measurable.GetCenter Coordinates
    
    MsgBox "x = " & Coordinates(0) & " ; y = " & Coordinates(1) & " ; z = " & Coordinates(2)
End Sub

C'est donc du VB Script et non pas du VBA.
De cette façon, je peux récupérer les "edges" des cylindres et trouver le centre dans le référentiel de l'assemblage.

Par contre j'ai essayé de rajouter la commande "measurable.GetRadius" mais ça me dit que ça ne gère pas cette méthode, une idée?

Salut Nicolas,

Pour le rayon : measurable.Radius

Si tu programmes en VBA tu peux voir la valeur des variables et leur différente méthode (voir image si dessous)
C'est très pratique pour la programmation, tu peux ensuite repasser en VBscript avec quelques restriction.

En fait je partais sur une mauvaise commande: Set Radius = measurable.GetRadius.
Dans ce cas là, Radius est un Long donc il fallait enlever le Set et puis c'est pas GetRadius mais .Radius.
La bonne écriture est donc measurable.Radius comme tu l'as écrit

Merci

Me revoila sur un petit problème: j'ai fait une boucle pour pouvoir faire une sélection multiple de mes bordures circulaires, cependant, lors du premier passage, j'ai toutes mes infos extraites mais après ça me dit que le type Coordinates est non compatible, ce qui est bizarre car il l'est durant le 1er passage.
Je mets mon code au cas où quelqu'un voudrait le tester

Code:

Sub CATMain()

    Dim intNbEdges As Integer
    Dim doc, sel, spa, ref, measurable
    Dim inputObjectType(0)
    Dim i As Integer
   
    Set doc = CATIA.ActiveDocument
    Set sel = doc.selection
    Set spa = doc.GetWorkbench("SPAWorkbench")
 
    'Selection of circular edge
    inputObjectType(0) = "TriDimFeatEdge"
    Status = sel.SelectElement3(inputObjectType, "Select the edge", False, CATMultiSelTriggWhenUserValidatesSelection, False)
    If (Status = "cancel") Then Exit Sub
 
  intNbEdges = sel.Count

  For i = 1 To intNbEdges

  Set ref = sel.Item(i).Reference
  Set measurable = spa.GetMeasurable(ref)
 
    Dim Coordinates(2)
    measurable.GetCenter Coordinates
    Dim Radius As Long
    Radius = measurable.Radius
   
    MsgBox "x = " & Coordinates(0) & Chr(10) & "y = " & Coordinates(1) & Chr(10) & "z = " & Coordinates(2) & Chr(10) & "Diametre = " & 2*Radius
   
    Err.Clear

    Next

End Sub


Ce code va donc permettre une extraction des bordures uniquement, et donner le centre et le rayon des bordures circulaires

Salut Nicolas,

Même erreur que toi en VBscript mais ça fonctionne en VBA

Salut Marc

En fait il faut rajouter un "On Error Resume Next" directement en début de boucle, juste après le "For i = 1 To intNbEdges" ainsi qu'un "On Error Goto 0" juste avant la MsgBox, et ça va marcher.

Par contre, aurais-tu une idée quant à la sélection: je voudrais sélectionner automatiquement les bordures circulaires de mon part via une boucle mais je n'arrive pas.
J'ai essayé plusieurs façons de faire, mais vu que j'ai des assemblages de 250+ pièces, il faudrait que ça se sélectionne tout seul.
J'ai essayé une palette de sélection par trappe, mais la trappe ne marche pas, juste la sélection par click, et comme j'ai dit plus haut, sur un assemblage de 250+ pièces, avec au moins 2 bordures par pièces, je peux pas faire ça à l'utilisateur

Code:

Status = sel.SelectElement3(inputObjectType, "Select the edge", False, CATMultiSelTriggWhenUserValidatesSelection, True)

et

Code:

selection.Search "(CATLndSearch.TriDimFeatEdge),all"

sachant que TriDimFeatEdge est utilisé pour faire une sélection des bordures circulaires.
Mais ça ne marche pas.

Salut Nicolas,

Je n'ai rien trouvé pour sélectionner directement les courbes, alors voici une nouvelle piste :
-sélectionner toutes les arrêtes avec sel.Search "Topology.CGMEdge,all"
-traiter celles iui sont du type "TriDimFeatEdge".

Ça donne :

Code:

Sub CATMain()
'*** http://catiav5.forumactif.org/t1456-extraction-de-points-d-esquisse#6498 ***

    Dim intNbEdges As Integer
    Dim doc, sel, spa, ref, measurable
    Dim inputObjectType(0)
    Dim i As Integer
  
    Set doc = CATIA.ActiveDocument
    Set sel = doc.Selection
    Set spa = doc.GetWorkbench("SPAWorkbench")
 
    sel.Search "Topology.CGMEdge,all"
    intNbEdges = sel.Count

    For i = 1 To intNbEdges
  
        Set myCircle = sel.Item(i)
        If myCircle.Type = "TriDimFeatEdge" Then
              
             Set ref = sel.Item(i).Reference
             Set measurable = spa.GetMeasurable(ref)
             Dim Coordinates(2)
             measurable.GetCenter Coordinates
             Dim Radius As Long
             Radius = measurable.Radius
            
             MsgBox "x = " & Coordinates(0) & Chr(10) & "y = " & Coordinates(1) & Chr(10) & "z = " & Coordinates(2) & Chr(10) & "Diametre = " & 2 * Radius
            
             Err.Clear
    End If
    Next

End Sub


Salut Marc,

C'est génial, merci!
J'avais essayé sel.Search("Type=TriDimFeatEdge, all") mais ça ne marchait pas, et je n'arrivais pas à trouver la bonne façon de l'écrire.

L'ennui avec la doc Catia c'est que des commandes et méthodes telles que Topology.CGMEdge ne sont pas renseignées, ce qui n'aide pas si on ne les connait pas...

En tout cas merci, je pense que je vais pouvoir finir tout seul

Je reviens sur ce que j'ai dit, j'ai un petit problème pour intégrer cette boucle dans ma plus grande boucle

Code:

Sub CATMain()

  Dim objProduct As Part
  Dim objProductMat As Part
  Dim intNbParts As Integer
  Dim i As Integer
    Dim intNbEdges As Integer
    Dim doc, sel, spa, ref, measurable
    Dim inputObjectType(0)
    Dim j As Integer

  StartCATIA
  If Err.Number <> 0 Then
    Exit Sub
  End If

  StartEXCEL
  If Err.Number <> 0 Then
    Exit Sub
  End If

  Set objGCATIASelection0 = objGCATIADocument0.Selection
  Set objGCATIAProduct0 = objGCATIADocument0.Product

  If objGCATIASelection0.Count = 0 Then
    objGCATIASelection0.Search "(CATLndSearch.Part),all"
  End If

  intNbParts = objGCATIASelection0.Count

  For i = 1 To intNbParts
    Set objProduct = Nothing
    Set objProductMat = Nothing

    Set objProduct = objGCATIASelection0.Item(i).Value
    Set objProductMat = objGCATIASelection0.Item(i)

    Err.Clear

    Dim objInertia As Inertia
    On Error Resume Next
    Set objInertia = objProduct.GetTechnologicalObject("Inertia")
    Dim getMass As String
    getMass = objInertia.Mass
    Dim partName As String
    partName = objProduct.Name
    Dim Mat As Material
    Dim oManager As MaterialManager
    Set oManager = objProductMat.GetItem("CATMatManagerVBExt")
    oManager.GetMaterialOnPart objProductMat.ReferenceProduct.Parent.Part,Mat
    matName = Mat.Name
    Dim Coordinates(2)
    objInertia.GetCOGPosition Coordinates
  
    Sel sel = Nothing
    Set spa = doc.GetWorkbench("SPAWorkbench")
 
    If sel.Count = 0 Then
        sel.Search "Topology.CGMEdge,all"
    End If
    intNbEdges = sel.Count
MsgBox intNbEdges
    For j = 1 To intNbEdges
  
        Set myCircle = sel.Item(j)
        If myCircle.Type = "TriDimFeatEdge" Then
              
             Set ref = sel.Item(j).Reference
             Set measurable = spa.GetMeasurable(ref)
             Dim oCoordinates(2)
             measurable.GetCenter oCoordinates
             Dim Radius As Long
             Radius = measurable.Radius
            
             MsgBox "x = " & oCoordinates(0) & Chr(10) & "y = " & oCoordinates(1) & Chr(10) & "z = " & oCoordinates(2) & Chr(10) & "Diametre = " & 2 * Radius
            
             Err.Clear
    End If
      WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleDepX, oCoordinates(0) & "mm"
      WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleDepY, oCoordinates(1) & "mm"
      WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleDepZ, oCoordinates(2) & "mm"

    Next

      intGReportCurrentRow = intGReportCurrentRow + 1
      InsertAnEXCELRowAt (intGReportCurrentRow)

      WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleMass, getMass
       WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleMaterial, matName
      WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleCOGX, Coordinates(0) & "mm"
      WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleCOGY, Coordinates(1) & "mm"
      WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleCOGZ, Coordinates(2) & "mm"
      WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitlePartName, partName

Next
    intGReportCurrentRow = intGReportCurrentRow + 1
    InsertAnEXCELRowAt (intGReportCurrentRow)

End Sub '/////////////////////////////////////////////////////////// CATMain

L'ennui c'est que j'ai l'impression que j'ai aucune sélection de mes edges qui se fait dans la boucle, ça doit être en rapport avec le sel, mais j'ai beau faire un Set sel= Nothing, ou un sel.Clear, ça me fait pas une sélection après...
J'ai également essayé un     Sel sel = objGCATIASelection0.Item(i) pour un     sel.Search "Topology.CGMEdge,all" après. Mais échec également

Aurais-tu également une écriture pour excel, à supposer que je garde 2 ou 3 jeux de coordonnées à chaque fois?
WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleDepX, oCoordinates(0) & "mm" pourrait marcher mais ça va uniquement prendre la dernière valeur
Dois-je rajouter un .Item(0) quelque part avant ou après le oCoordinates(0)?

Salut Nicolas,

Pour excel, je ne connais pas la syntaxe que tu utilise, pour remplir les tableaux j'utilise:

Code:

myworksheet.cells(i + 1, 3).Value = oCoorddinates(0)

Voir un exemple ici:
https://catiav5.forumactif.org/t1452-catdrawing-vers-excel

Pour le problème de boucle je regarderai plus tard.

Pour mon fichier excel, j'ai un fichier de base référenct et le code va se baser dessus.

L'écriture se passe comme ceci (en gros) pour l'écriture excel:

Code:

Const strGReportTitleDepX = "Départ X-Coord"
Dim intWhichColumn As Integer
intWhichColumn = 0
If (Len(istrValue) > 0) Then
   Select Case iStrColumn
         Case strGReportTitleDepX
             intWhichColumn = intGReportStartAfterColumn + 14
    End Select
End If
'// execution code
'//
WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleDepX oCoordinates(0) & "mm"
intGReportCurrentRow = intGReportCurrentRow +1

Voila comment est organisé mon code, mais dans ce cas là, comment je peux faire pour prendre les coordonnées du premier item (edge circulaire) et les nommer en "coordonnées départ" puis prendre les coordonnées du 2e item pour "coordonnées fin" ...?

Je crois avoir compris d'où vient mon problème dans la boucle: je fais une première sélection avec objGCATIASelection0.Search "(CATLndSearch.Part),all".
Et après j'ai à faire une sélection, donc soit je fais un set sel = catia.Activedocument.selection, et dans ce cas, ça va me prendre les bordures de la sélection totale, soit j'ai fait un catia.activedocument.selection.item(i), ce qui ne marche pas avec sel.Search "topology.CGMEdge, all" vu que je suis sur un item et non pas une sélection.

Donc en fait il faut que je fasse une sélection de l'ensemble des Part, que je prenne l'item i, et dans cet item que je fasse une sélection de l'ensemble des bordures...

Bon ben malgré toutes mes tentatives, cela n'a rien donné.
Donc si quelqu'un a une idée sur comment corriger mon script pour que je puisse faire une sélection générale des parts, puis après, dans chaque item, faire une sélection des edges, ce serait très sympa qu'il m'aide
Merci

Salut Nicolas,

Peux tu poster le code complet, je pourrai le tester.
Tu lance bien ta macro avec un Catproduct (contenant tes CATpart tubes, coudes...) actif?

Re..

Cette macro qui déroule le contenu d'un Product peut éventuellement t'aider:

Code:

'---Script by Emmett Ross
'---www.scripting4v5.com
'---Revised July 21, 2012
'---This macro will walk down the tree and display the part number for every component and if it is a part or product
'--------------------------------------------------------------------------

Sub CATMain()

    'Get the current CATIA assembly
    Dim oProdDoc As ProductDocument
    Set oProdDoc = CATIA.ActiveDocument

    Dim oRootProd As Product
    Set oRootProd = oProdDoc.Product
       
    'Begin scroll down the specification tree
    Call WalkDownTree(oRootProd)
 
End Sub

'---------------------------------------------------------------------
' WalkDownTree is a recursive function to scroll down the spec tree and output names of each item

Sub WalkDownTree(oInProduct As Product)

  Dim oInstances As Products
  Set oInstances = oInProduct.Products

'-----No instances found then this is CATPart

  If oInstances.Count = 0 Then
   
    MsgBox "This is a CATPart with part number " & oInProduct.PartNumber
 
Exit Sub
  End If
 
'-----Found an instance therefore it is a CATProduct

MsgBox "This is a CATProduct with part number " & oInProduct.ReferenceProduct.PartNumber
 
Dim k As Integer
    For k = 1 To oInstances.Count
        Dim oInst As Product
        Set oInst = oInstances.Item(k)

        'apply design mode
        oInstances.Item(k).ApplyWorkMode DESIGN_MODE
        Call WalkDownTree(oInst)
    Next

End Sub



Salut Marc,

Je te poste ça et je vais voir la macro que tu as posté!
Merci

Code:

Code:


Const intGTraceLevel = 1

'// ---------- EXCEL Run Report Format
Const strGReportTitleInstanceName = "Run name"
Const strGReportTitleNodeNumber = "Node name"
Const strGReportTitleNodeX = "X-coord"
Const strGReportTitleNodeY = "Y-coord"
Const strGReportTitleNodeZ = "Z-coord"
Const strGReportTitleBlendRadius = "Bend radius"
Const strGReportTitleNominalSize = "Diameter"
Const strGReportTitlePartName = "Nom Pièce"
Const strGReportTitleMass = "Masse"
Const strGReportTitleMaterial = "Matériau"
Const strGReportTitleCOGX = "CdG X-coord"
Const strGReportTitleCOGY = "CdG Y-coord"
Const strGReportTitleCOGZ = "CdG Z-coord"
Const strGReportTitleDepX = "Départ X-coord"
Const strGReportTitleDepY = "Départ Y-coord"
Const strGReportTitleDepZ = "Départ Z-coord"
Const strGReportTitleEndX = "Fin X-coord"
Const strGReportTitleEndY = "Fin Y-coord"
Const strGReportTitleEndZ = "Fin Z-coord"

Dim intGReportCurrentRow As Integer
Dim intGReportCurrentColumn As Integer

'// ---------- User customizable sections
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

'// ----------  Do not write over row 1, that's the header in the template
Const intGReportStartAfterRow = 2
Const intGReportStartAfterColumn = 0

'// ---------- EXCEL template direction path
Const strGReportTemplate ="C:\Users\nicolas\Desktop\test.xlsx"

'// ---------- Name the sheet in the template accordingly
Const strGReportEXCELSheetName = "Run Properties"

'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

'// ---------- CATIAV5 application objects
Dim objGCATIADocument0 As Document
Dim objGCATIASelection0 As Selection
Dim objGCATIAProduct0 As Product
Dim sel As Selection

'// ---------- EXCEL application objects
Dim objGEXCELApp 'As AnyObject
Dim objGEXCELWorkBooks 'As AnyObject
Dim objGEXCELWorkBook 'As AnyObject
Dim objGEXCELWorkSheets 'As AnyObject
Dim objGEXCELWorkSheet 'As AnyObject


'------------------------------------------------------------------------------
Sub WriteToEXCELRunSheet(iIntRow, iStrColumn, iStrValue)

  Dim intWhichColumn As Integer

  On Error Resume Next

  intWhichColumn = 0
  If (Len(iStrValue) > 0) Then
    Select Case iStrColumn
      Case strGReportTitleInstanceName
        intWhichColumn = intGReportStartAfterColumn + 1
      Case strGReportTitleNodeNumber
        intWhichColumn = intGReportStartAfterColumn + 2
      Case strGReportTitleNodeX
        intWhichColumn = intGReportStartAfterColumn + 3
      Case strGReportTitleNodeY
        intWhichColumn = intGReportStartAfterColumn + 4
      Case strGReportTitleNodeZ
        intWhichColumn = intGReportStartAfterColumn + 5
      Case strGReportTitleBlendRadius
        intWhichColumn = intGReportStartAfterColumn + 6
      Case strGReportTitleNominalSize
        intWhichColumn = intGReportStartAfterColumn + 7
      Case strGReportTitlePartName
        intWhichColumn = intGReportStartAfterColumn + 8
      Case strGReportTitleMass
        intWhichColumn = intGReportStartAfterColumn + 9
      Case strGReportTitleMaterial
        intWhichColumn = intGReportStartAfterColumn + 10
      Case strGReportTitleCOGX
        intWhichColumn = intGReportStartAfterColumn + 11
      Case strGReportTitleCOGY
        intWhichColumn = intGReportStartAfterColumn + 12
      Case strGReportTitleCOGZ
        intWhichColumn = intGReportStartAfterColumn + 13
      Case strGReportTitleDepX
        intWhichColumn = intGReportStartAfterColumn + 14
      Case strGReportTitleDepY
        intWhichColumn = intGReportStartAfterColumn + 15
      Case strGReportTitleDepZ
        intWhichColumn = intGReportStartAfterColumn + 16
      Case strGReportTitleEndX
        intWhichColumn = intGReportStartAfterColumn + 17
      Case strGReportTitleEndY
        intWhichColumn = intGReportStartAfterColumn + 18
      Case strGReportTitleEndZ
        intWhichColumn = intGReportStartAfterColumn + 19

    End Select

    If (intWhichColumn > intGReportStartAfterColumn) Then
       objGEXCELWorkSheet.Cells(iIntRow, intWhichColumn) = iStrValue
       objGEXCELWorkSheet.Cells(iIntRow, intWhichColumn).Select
    End If
  End If

End Sub '////////////////////////////////////////////////////// WriteToEXCELRunSheet

'------------------------------------------------------------------------------
Sub InsertAnEXCELRowAt(iIntRow)

  objGEXCELWorkSheet.Cells(iIntRow, 1).EntireRow.Select
  objGEXCELApp.Selection.Insert
  objGEXCELWorkSheet.Cells(iIntRow, 1).EntireRow.Select

End Sub '///////////////////////////////////////////////////////// InsertAnEXCELRowAt


'------------------------------------------------------------------------------
Sub StartEXCEL()

  Err.Clear
  On Error Resume Next

  Set objGEXCELApp = GetObject(, "EXCEL.Application")
  If AppExcel Is Nothing Then
    Err.Clear
    Set objGEXCELApp = CreateObject("EXCEL.Application")
  End If

  objGEXCELApp.Application.Visible = True
  Err.Clear

  Set objGEXCELWorkBooks = objGEXCELApp.Application.workbooks
  Set objGEXCELWorkBook = objGEXCELWorkBooks.Add(strGReportTemplate)
  If Err.Number <> 0 Then
    MsgBox "Vérifiez que vous disposez de droits en lecture sur le fichier suivant :" & Chr(10) & strGReportTemplate, _
           vbOkOnly + vbCritical, "Erreur de chargement du template Excel" + Err.Number
    Exit Sub
  End If

  Set objGEXCELWorkSheets = objGEXCELWorkBook.Worksheets
  Set objGEXCELWorkSheet = objGEXCELWorkSheets(strGReportEXCELSheetName)

  intGReportCurrentColumn = intGReportStartAfterColumn
  intGReportCurrentRow = intGReportStartAfterRow
  objGEXCELWorkSheet.Select

  Err.Clear

End Sub '/////////////////////////////////////////////////////////// StartEXCEL


'------------------------------------------------------------------------------
Sub EndEXCEL()

  objGEXCELWorkBook.Close

  objGEXCELApp.Quit

End Sub '///////////////////////////////////////////////////////////// EndEXCEL


'------------------------------------------------------------------------------
Sub StartCATIA()

  Err.Clear
  On Error Resume Next

  '//---------- Get the active document
  Set objGCATIADocument0 = CATIA.ActiveDocument
  If Err.Number <> 0 Then
    MsgBox "Vous devez avoir un document actif chargé en session !", _
    vbOkOnly + vbCritical, "Erreur au chargement du modèle"
    Exit Sub
  End If

  '//---------- Get current selection & root product
  Set objGCATIASelection0 = objGCATIADocument0.Selection
  Set objGCATIAProduct0 = objGCATIADocument0.Product

  If objGCATIASelection0.Count = 0 Then
    objGCATIASelection0.Search "(CATLndSearch.Part),all"
  End If

  Err.Clear

End Sub '/////////////////////////////////////////////////////////// StartCATIA


'------------------------------------------------------------------------------
Sub CATMain()

  Dim objProduct As Part
  Dim objProductMat As Part
  Dim intNbParts As Integer
  Dim i As Integer
    Dim intNbEdges As Integer
    Dim doc, sel, spa, ref, measurable
    Dim inputObjectType(0)
    Dim j As Integer

  StartCATIA
  If Err.Number <> 0 Then
    Exit Sub
  End If

  StartEXCEL
  If Err.Number <> 0 Then
    Exit Sub
  End If

  intNbParts = objGCATIASelection0.Count

  For i = 1 To intNbParts
    Set objProduct = Nothing
    Set objProductMat = Nothing

    Set objProduct = objGCATIASelection0.Item(i).Value
    Set objProductMat = objGCATIASelection0.Item(i)

    Err.Clear

    Dim objInertia As Inertia
    On Error Resume Next
    Set objInertia = objProduct.GetTechnologicalObject("Inertia")
    Dim getMass As String
    getMass = objInertia.Mass
    Dim partName As String
    partName = objProduct.Name
    'Dim Mat As Material
    'Dim oManager As MaterialManager
    'Set oManager = objProductMat.GetItem("CATMatManagerVBExt")
    'oManager.GetMaterialOnPart objProductMat.ReferenceProduct.Parent.Part,Mat
    'matName = Mat.Name
    Dim Coordinates(2)
    objInertia.GetCOGPosition Coordinates

MsgBox intNbParts  
    Set sel = CATIA.ActiveDocument.Selection.Item(i)
    Set spa = CATIA.ActiveDocument.GetWorkbench("SPAWorkbench")
    sel.Search "Topology.CGMEdge,all"
    intNbEdges = sel.Count
MsgBox intNbEdges
    For j = 1 To intNbEdges

        Set myCircle = sel.Item(j)
        If myCircle.Type = "TriDimFeatEdge" Then
              
             Set ref = sel.Item(j).Reference
             Set measurable = spa.GetMeasurable(ref)
             Dim oCoordinates(2)
             measurable.GetCenter oCoordinates
             Dim Radius As Long
             Radius = measurable.Radius
            
             MsgBox "x = " & oCoordinates(0) & Chr(10) & "y = " & oCoordinates(1) & Chr(10) & "z = " & oCoordinates(2) & Chr(10) & "Diametre = " & 2 * Radius
            
             Err.Clear
    End If
      WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleDepX, oCoordinates(0) & "mm"
      WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleDepY, oCoordinates(1) & "mm"
      WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleDepZ, oCoordinates(2) & "mm"

    Next

      intGReportCurrentRow = intGReportCurrentRow + 1
      InsertAnEXCELRowAt (intGReportCurrentRow)

      WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleMass, getMass
      WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleMaterial, matName
      WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleCOGX, Coordinates(0) & "mm"
      WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleCOGY, Coordinates(1) & "mm"
      WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleCOGZ, Coordinates(2) & "mm"
      'WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleEndX, oCoordinates(0) & "mm"
      'WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleEndY, oCoordinates(1) & "mm"
      'WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleEndZ, oCoordinates(2) & "mm"
      WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitlePartName, partName

Next
    intGReportCurrentRow = intGReportCurrentRow + 1
    InsertAnEXCELRowAt (intGReportCurrentRow)

End Sub '/////////////////////////////////////////////////////////// CATMain


Là dans ce cas là, il me donne pas les extrémités, mais il me donne les infos sur les pièces.
Mais quand je modifie la 2ème sélection pour faire une sélection globale, dans ce cas là, ça me sort les extrémités globales et ça me change les noms de la pièce dans le fichier excel

Salut Nicolas,

Il y a effectivement un problème avec les sélections, ors du 2è passage dans la boucle i, la sélection des parts prend la valeur de la sélection des Edges.
J'ai donc supprimé cette sélection et utilisé les instances pour balayer les Parts (attention ne fonctionne pas si plusieurs niveaux).
Mais je rencontre de nouveaux PB:
-les mesures des coordonnées se font dans le repère pièce et non pas product
-comment dissocier le cercle de départ du cercle d'arrivé surtout si la part en a plus que 2 (voir Part3 de mon exemple).
Ci dessous le Catproduct exemple et le résultat excel:

Salut Marc,
Merci pour ton analyse!

Pour l'instant je n'ai pas de problème de coordonnées: il me prend effectivement toutes les edges et pas celles de l'objet sélectionné, mais c'est dans le système assembly et non pas dans le système du part, donc peut être que ça doit venir de la sélection d'instances.

Pour ce qui est de plusieurs edges circulaires, effectivement, c'est problèmatique. Mais je n'enlève pas une possibilité de correction de ce problème dans la partie post-traitement, même à la main, si les erreurs sont limitées.
Dans mes assemblages, il y a des "té", donc je pourrais prendre un 3e jeu de coordonnées comme étant la branche sortant du té.
Et s'il y a plus (comme sur ta réduction), ça pourrait comprendre que c'est une pièce particulière qui serait en post-traitement.

Mon ultime recours serait de faire une sélection manuelle des edges sur chaque pièce, mais alors il faudrait faire un zoom sur pièce au moment de la sélection, et sur un assemblage de 200+ pièces, la selection manuelle serait d'un temps non négligeable...

Je suis vraiment bloqué sur cette sélection et je n'arrive pas à comprendre pourquoi il ne veut pas me faire 2 sélections distinctes...

Merci en tout cas de m'accorder ton temps

Salut Nicolas,

Une autre proposition pour résoudre le problème de sélection : transférer la sélection de Part dans un tableau et utiliser ce tableau dans la boucle i à la place de la sélection (j'ai commenté les lignes modifiées avec '*ML*):

Code:

StartEXCEL
  If Err.Number <> 0 Then
    Exit Sub
  End If
  
'*ML* test tableau
    intNbParts = objGCATIASelection0.Count
    ReDim myPartArray(intNbParts - 1)
    For k = 1 To intNbParts
        '*ML*Set objProduct = objGCATIASelection0.Item(k) '.Value
        Set myPartArray(k - 1) = objGCATIASelection0.Item(k).Value
    Next k
    
    
  For i = 1 To intNbParts
    Set objProduct = Nothing
    Set objProductMat = Nothing

    '*ML*Set objProduct = objGCATIASelection0.Item(i).Value
    '*ML*Set objProductMat = objGCATIASelection0.Item(i)
    Set objProduct = myPartArray(i - 1) '*ML*
    Err.Clear

Pour différencier la première arrête de la deuxième (ou plus) j'ai rajouté une condition pour vérifier si le cercle appartient à la Part pour un compteur pour savoir si c'est le premier cercle de la Part. J'ai également modifié l'écriture d'Excel pour créer une ligne pour chaque cercle et arrondi les valeurs de coordonnées à 3 décimales:

Code:

   EdgeNB = 1 '*ML*
'MsgBox intNbEdges
    For j = 1 To intNbEdges

        Set myCircle = sel.Item(j)
        If myCircle.Type = "TriDimFeatEdge" Then
            If myCircle.LeafProduct.Name = partName Then '*ML*
                Set ref = sel.Item(j).Reference
                Set measurable = spa.GetMeasurable(ref)
                Dim oCoordinates(2)
                measurable.GetCenter oCoordinates
                Dim Radius As Long
                Radius = measurable.Radius
                
                'MsgBox partName & " x = " & oCoordinates(0) & Chr(10) & "y = " & oCoordinates(1) & Chr(10) & "z = " & oCoordinates(2) & Chr(10) & "Diametre = " & 2 * Radius
                
                Err.Clear
                
                WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitlePartName, partName
                WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleCOGX, Round(Coordinates(0), 3) & "mm"
                WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleCOGY, Round(Coordinates(1), 3) & "mm"
                WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleCOGZ, Round(Coordinates(2), 3) & "mm"
                WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleMass, getMass
                WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleMaterial, matName
                If EdgeNB = 1 Then 'si premier cercle alors départ
                    WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleDepX, Round(oCoordinates(0), 3) & "mm"
                    WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleDepY, Round(oCoordinates(1), 3) & "mm"
                    WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleDepZ, Round(oCoordinates(2), 3) & "mm"
                Else 'sinon les cercles suivants dans colonnes Fin
                    WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleEndX, Round(oCoordinates(0), 3) & "mm"
                    WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleEndY, Round(oCoordinates(1), 3) & "mm"
                    WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleEndZ, Round(oCoordinates(2), 3) & "mm"
                End If
                intGReportCurrentRow = intGReportCurrentRow + 1
                InsertAnEXCELRowAt (intGReportCurrentRow)
                
                EdgeNB = EdgeNB + 1
            End If  '= "TriDimFeatEdge"
        End If      '= partName

    Next j
Next i
 
End Sub '/////////////////////////////////////////////////////////// CATMain

Résultat:

Salut Marc!

Wow! Merci ça marche super bien! Effectivement, l'idée du tableau est super efficace! J'y avais pensé mais je ne savais pas comment le mettre en place!

J'ai également remarqué que faire une sélection au préalable permettait d'exécuter la macro juste sur les pièce sélectionnées, ce qui serait pratique pour une extraction locale exceptionnelle.

Je pense qu'il va falloir que je trouve un moyen pour limiter le nombre de sortie à 4 (nombre maximum de coordonnées pour un tuyau qui sera une réduction).
Donc je pense qu'il va falloir que je rajoute une condition dans la boucle