catdrawing vers excel

Voir le sujet précédent Voir le sujet suivant Aller en bas

catdrawing vers excel

Message par fanch-bzh le Jeu 12 Mai 2016 - 1:25

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

fanch-bzh
timide
timide

Messages : 11
Date d'inscription : 09/07/2010

Revenir en haut Aller en bas

Re: catdrawing vers excel

Message par Nico_atomique le Jeu 12 Mai 2016 - 2:39

Salut

Je pense que tu devrais trouver ta réponse Ici

Nico_atomique
actif
actif

Messages : 38
Date d'inscription : 20/04/2016
Localisation : Marseille/Aix-en-Provence

Revenir en haut Aller en bas

Re: catdrawing vers excel

Message par fanch-bzh le Jeu 12 Mai 2016 - 2:57

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

fanch-bzh
timide
timide

Messages : 11
Date d'inscription : 09/07/2010

Revenir en haut Aller en bas

Re: catdrawing vers excel

Message par Nico_atomique le Jeu 12 Mai 2016 - 3:02

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é

Nico_atomique
actif
actif

Messages : 38
Date d'inscription : 20/04/2016
Localisation : Marseille/Aix-en-Provence

Revenir en haut Aller en bas

Re: catdrawing vers excel

Message par lumpazepfel le Ven 13 Mai 2016 - 23:06

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:
avatar
lumpazepfel
actif
actif

Messages : 141
Date d'inscription : 03/11/2015
Localisation : Ensisheim

Revenir en haut Aller en bas

Re: catdrawing vers excel

Message par fanch-bzh le Lun 23 Mai 2016 - 19:31

Merci

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



fanch-bzh
timide
timide

Messages : 11
Date d'inscription : 09/07/2010

Revenir en haut Aller en bas

Re: catdrawing vers excel

Message par Contenu sponsorisé


Contenu sponsorisé


Revenir en haut Aller en bas

Voir le sujet précédent Voir le sujet suivant Revenir en haut

- Sujets similaires

 
Permission de ce forum:
Vous ne pouvez pas répondre aux sujets dans ce forum