catdrawing vers excel
3 participants
Page 1 sur 1
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
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
- Messages : 12
Date d'inscription : 09/07/2010
Re: catdrawing vers excel
Salut
Je pense que tu devrais trouver ta réponse Ici
Je pense que tu devrais trouver ta réponse Ici
Nico_atomique- actif
- Messages : 38
Date d'inscription : 19/04/2016
Localisation : Marseille/Aix-en-Provence
Re: catdrawing vers excel
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
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
- Messages : 12
Date d'inscription : 09/07/2010
Re: catdrawing vers excel
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
- Messages : 38
Date d'inscription : 19/04/2016
Localisation : Marseille/Aix-en-Provence
Re: catdrawing vers excel
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.
Un aperçu du résultat:
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:
lumpazepfel- Fédérateur
- Messages : 319
Date d'inscription : 02/11/2015
Localisation : Ensisheim
Re: catdrawing vers excel
Merci
je vais analyser tout ça , et je vous tiens au jus
je vais analyser tout ça , et je vous tiens au jus
fanch-bzh- timide
- Messages : 12
Date d'inscription : 09/07/2010
Page 1 sur 1
Permission de ce forum:
Vous ne pouvez pas répondre aux sujets dans ce forum
|
|