catdrawing vers excel

Bonjour toutes et tous

Je cherche une macros pour récupérer tous les cotes d'un catdrawing et les envoyer sur un fichier excel pour en faire une carte de contrôle
Peut etre que quelqu'un à déja fait le job

Merci de m'aider

Salut

Je pense que tu devrais trouver ta réponse Ici

Merci
Mais j'ai déja regardé , sur ce forum et sur d'autres mais . et j'ai utilisé/modifé quelques unes de leur macros , mais trop d'adaptation pour mon niveau

l'idéal ce serait

mais bon , je rève

Je pense malheureusement qu'il va falloir que tu écrives ta propre macro (ou adapte les autres à tes besoins). Cette vidéo montre un truc professionnel, il est probable que Continental l'aie développé

Bonjour,

Ci joint un début de code en VBA pour extraire les cotations vers Excel.
Toutes les variantes de cotes,tolérance... ne sont peut être pas traitées. A voir en fonction des besoins.

Code:

' ------------------------------------------------------
' *** Macro d'export des cotations d'un Catdrawing   ***
' ***           vers Excel                           ***
' ***           Langage VBA                          ***
' ------------------------------------------------------


Sub CATMain()

Dim myDrawing As DrawingDocument

Dim oTolType As Long
Dim oTolName As String
Dim oUpTol As String
Dim oLowTol As String
Dim odUpTol As Double
Dim odLowTol As Double
Dim oDisplayMode As Long

' ------------------------------------------------------
' *** Vérifie si le document actif est un CATDrawing ***
' ------------------------------------------------------

On Error Resume Next
Set myDrawing = CATIA.ActiveDocument
If (Err.Number <> 0) Then
    MsgBox ("Un CATDrawing doit être actif")
    
    Exit Sub
End If
If (InStr(myDrawing.Name, ".CATDrawing")) = 0 Then
    MsgBox ("La fenêtre active doit être un CATDrawing")
        Exit Sub
End If
Err.Clear
On Error GoTo 0

' *** Sélectionne toutes les cotes ***

Dim selection1 As Selection
Set selection1 = myDrawing.Selection
selection1.Clear
selection1.Search "CATDrwSearch.DrwDimension,all"

' *** Lance Excel ***

Dim xl As Object 'Excel.Application
On Error Resume Next
Set xl = GetObject(, "Excel.Application")
If Err <> o Then
    Set xl = CreateObject("Excel.Application")
    xl.Visible = True
End If

Set workbooks = xl.Application.workbooks
Set myworkbook = xl.workbooks.Add
Set myworksheet = xl.ActiveWorkbook.Add
Set myworksheet = xl.Sheets.Add

' *** titre des colonnes d'Excel ***

myworksheet.Range("A1").Value = "Type"
myworksheet.Range("B1").Value = "Cote"
myworksheet.Range("C1").Value = "Tolérance mini"
myworksheet.Range("D1").Value = "Tolérance maxi"

' *** traitement des cotations ***

For i = 1 To selection1.Count
    Set MyDimension = selection1.Item(i).Value
    MyDimensionValue = MyDimension.GetValue.Value
    ' traitement des tolérances
    MyDimension.GetTolerances oTolType, oTolName, oUpTol, oLowTol, odUpTol, odLowTol, oDisplayMode
    myworksheet.cells(i + 1, 2).Value = MyDimensionValue
    If oTolType = 1 Then 'tolérance numérique
        myworksheet.cells(i + 1, 3).Value = odLowTol
        myworksheet.cells(i + 1, 4).Value = odUpTol
    End If
        If oTolType = 2 Then 'tolérance alphanumérique
        myworksheet.cells(i + 1, 3).Value = oLowTol
        myworksheet.cells(i + 1, 4).Value = oUpTol
    End If
    ' traitement des types de cotations
    MyDimType = MyDimension.DimType
    Select Case MyDimType
        Case 5, 6, 7, 8, 17, 19         'cote type rayon
            MyDimTypeTexte = "R"
        Case 9, 10, 11, 12, 13, 18
            MyDimTypeTexte = "Ø"        'cote type diamètre
        Case 14
            MyDimTypeTexte = "Ch"       'cote type chanfrein
        Case 4
            MyDimTypeTexte = "Angle"    'cote d'angle
        Case Else
            MyDimTypeTexte = ""         'cote type longueur-distance
    End Select
    myworksheet.cells(i + 1, 1).Value = MyDimTypeTexte
    
    odLowTol = 0
    odUpTol = 0
    oUpTol = ""
    oLowTol = ""

Next

End Sub


Un aperçu du résultat:

Merci

je vais analyser tout ça , et je vous tiens au jus