Code:
' ------------------------------------------------------
' *** Macro d'export des cotations d'un Catdrawing ***
' *** vers Excel ***
' *** Langage VBA ***
'https://catiav5.forumactif.org/t1452-catdrawing-vers-excel
' ------------------------------------------------------
'voir aussi https://www.eng-tips.com/viewthread.cfm?qid=345707 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