Pb recuperation tolerance dans VBA

Bonjour à tous,

je tente de créér une macro permettant d’extraire une série de cotes sélectionnées dans un plan, et de les exporter sous Excel.
Je récupère en passant trois propriétés, permettant d’identifier rapidement le fichier depuis lequel on été extraites les cotes.

La macro fonctionne parfaitement (la mise en page est Ok, les propriétés sont bien récupérées, les cotes sélectionnées apparaissent bien ), à ceci prêt que les tolérances sorte systématiquement à zéro…

Chat GPT, qui m’a été d’une grande aide lors de la création de cette macro, butte sur le problème. Une autre IA, Claude, n’a pas pu faire mieux.

est ce que quelqu’un saurait ce qui fait que la valeur zéro est systématiquement remontée? Je précise que sur les cote que je sélectionne sur mon plan pour tester ont bien une tolérance, symétrique, de +/-0.15, rentré directement depuis le property manager cotation.

Option Explicit

Sub main()
    ExportCotesVersExcel
End Sub

Sub ExportCotesVersExcel()
    Dim swApp As Object
    Dim swModel As Object
    Dim swDraw As Object
    Dim swSelMgr As Object
    Dim swDispDim As Object
    Dim swDim As Object
    Dim xlApp As Object
    Dim xlWorkbook As Object
    Dim xlSheet As Object
    Dim i As Integer
    Dim j As Integer
    Dim tolMin As Double
    Dim tolMax As Double
    Dim value As Double
    Dim valueMin As Double
    Dim valueMax As Double
    Dim itMin As Double
    Dim itMax As Double
    
    ' Créer une instance de SolidWorks (Late Binding)
    Set swApp = CreateObject("SldWorks.Application")
    Set swModel = swApp.ActiveDoc
    
    ' Vérification si un dessin est actif
    If swModel Is Nothing Then
        MsgBox "Veuillez ouvrir un dessin 2D avant d'exécuter la macro.", vbExclamation
        Exit Sub
    End If
    
    ' Vérification du type de document
    If swModel.GetType <> 3 Then ' 3 correspond à swDocDRAWING
        MsgBox "Cette macro fonctionne uniquement sur un dessin 2D.", vbExclamation
        Exit Sub
    End If
    
    Set swDraw = swModel
    Set swSelMgr = swModel.SelectionManager
    
    ' Créer une instance d'Excel (Late Binding)
    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application") ' Vérifier si Excel est ouvert
    If xlApp Is Nothing Then
        Set xlApp = CreateObject("Excel.Application") ' Ouvrir Excel si ce n'est pas le cas
    End If
    On Error GoTo 0
    
    xlApp.Visible = True
    Set xlWorkbook = xlApp.Workbooks.Add
    Set xlSheet = xlWorkbook.Sheets(1)
    
    ' Entêtes Excel pour les propriétés
    xlSheet.Cells(1, 1).value = "Référence M3_2D"
    xlSheet.Cells(2, 1).value = "Indice"
    xlSheet.Cells(3, 1).value = "Description"
    
    ' Ajouter une ligne vide après les propriétés
    xlSheet.Cells(4, 1).value = ""
    
    ' Récupérer les propriétés du modèle (Référence M3_2D, Indice, Description)
    Dim customProps As Object
    Set customProps = swModel.Extension.CustomPropertyManager("")

    Dim refM3_2D As String
    Dim indice As String
    Dim description As String
    
    ' Essayer de récupérer les propriétés en tenant compte des erreurs
    On Error Resume Next
    refM3_2D = customProps.Get("Référence M3_2D")
    If Err.Number <> 0 Then refM3_2D = "Non disponible"
    
    indice = customProps.Get("Indice")
    If Err.Number <> 0 Then indice = "Non disponible"
    
    description = customProps.Get("Description")
    If Err.Number <> 0 Then description = "Non disponible"
    On Error GoTo 0
    
    ' Ajouter les propriétés dans Excel
    xlSheet.Cells(1, 2).value = refM3_2D
    xlSheet.Cells(2, 2).value = indice
    xlSheet.Cells(3, 2).value = description
    
    ' Ajouter une ligne vide après les propriétés
    xlSheet.Cells(4, 1).value = ""
    
    ' Ajouter les en-têtes pour les cotes
    xlSheet.Cells(5, 1).value = "Nom de la cote"
    xlSheet.Cells(5, 2).value = "Valeur"
    xlSheet.Cells(5, 3).value = "IT Min"
    xlSheet.Cells(5, 4).value = "IT Max"
    xlSheet.Cells(5, 5).value = "Valeur Cote Min"
    xlSheet.Cells(5, 6).value = "Valeur Cote Max"
    
    ' Vérifier si des cotes sont sélectionnées
    Dim nbCotes As Integer
    nbCotes = swSelMgr.GetSelectedObjectCount()
    
    If nbCotes = 0 Then
        MsgBox "Veuillez sélectionner des cotes avant d'exécuter la macro.", vbExclamation
        Exit Sub
    End If

    ' Parcours des cotes sélectionnées
    i = 6 ' Commencer à la ligne 6 après les propriétés, la ligne vide et les en-têtes
    Dim ent As Object
    For j = 1 To nbCotes
        Set ent = swSelMgr.GetSelectedObject6(j, -1)
        
        ' Vérifier si l'entité sélectionnée est une cote
        If Not ent Is Nothing Then
            If TypeOf ent Is SldWorks.DisplayDimension Then
                Set swDispDim = ent
                Set swDim = swDispDim.GetDimension
                
                ' Vérification de swDim avant d’accéder à ses valeurs
                If Not swDim Is Nothing Then
                    ' Récupérer la valeur de la cote
                    value = swDim.value
                    
                    ' Calcul des valeurs min et max de la cote
                    valueMin = value - tolMin
                    valueMax = value + tolMax
                    
                    ' Récupérer les tolérances IT (si disponibles)
                    On Error Resume Next
                    itMin = swDim.tolerance.itMin
                    itMax = swDim.tolerance.itMax
                    On Error GoTo 0
                    
                    ' Si les tolérances IT ne sont pas disponibles, les assigner à 0
                    If IsError(itMin) Then itMin = 0
                    If IsError(itMax) Then itMax = 0
                    
                    ' Exporter la cote, sa valeur, les tolérances IT et les valeurs min et max dans Excel
                    xlSheet.Cells(i, 1).value = swDim.FullName ' Nom de la cote
                    xlSheet.Cells(i, 2).value = Round(value, 2) ' Valeur de la cote
                    xlSheet.Cells(i, 3).value = Round(itMin, 2) ' Tolérance IT Min
                    xlSheet.Cells(i, 4).value = Round(itMax, 2) ' Tolérance IT Max
                    xlSheet.Cells(i, 5).value = Round(valueMin, 2) ' Valeur min de la cote
                    xlSheet.Cells(i, 6).value = Round(valueMax, 2) ' Valeur max de la cote
                    
                    i = i + 1
                Else
                    Debug.Print "Erreur : swDim est null pour un élément sélectionné."
                End If
            Else
                Debug.Print "L'élément sélectionné n'est pas une cote."
            End If
        Else
            Debug.Print "Erreur : ent est null pour l'élément " & j
        End If
    Next j
    
    ' Ajuster la largeur de la colonne A en fonction de son contenu
    xlSheet.Columns("A:A").AutoFit
    
    MsgBox "Exportation terminée avec succès !", vbInformation
End Sub

tolMin et tolmax sont bien déclaré mais aucune valeur leur est assigné nul part.

Pour récupéré la valeur d’une tolérance j’ai ajouté:

                Dim swDimTol As SldWorks.DimensionTolerance
                Set swDimTol = swDim.Tolerance
                If swDimTol.Type <> swTolType_e.swTolNONE Then
                Debug.Print swDimTol.GetMinValue
                Debug.Print swDimTol.GetMaxValue
                End If

juste en dessous de ton code:

                ' Récupérer la valeur de la cote
                value = swDim.value

Et je récupère bien la valeur des tolérances dans les debug.print restera à finaliser le code avec ces valeurs

Et pour information attention à chat GPT et compagnie, il faut impérativement regarder et comprendre le code car il a une fâcheuse tendance à mettre du code inutile et non aboutie!
Et visiblement beaucoup de mal sur du code SW (tu n’est pas le 1er as te faire avoir)

Edit:
Pour le code il est impératif de mettre l’entièreté du code entre balise, pour cela cliquer ici puis coller le code:
image

Sinon le code est illisible. Merci d’éditer ton 1er post et de corriger si possible.

2 « J'aime »

Il faut multiplier la valeurs des tolérance par 1000.
Sinon erreur d’unité et cala arrondi à 0 avec la fonction Round(valeur,2).
Pour le code final qui semble fonctionnel:

Option Explicit

Sub main()
ExportCotesVersExcel
End Sub

Sub ExportCotesVersExcel()
Dim swApp As Object
Dim swModel As Object
Dim swDraw As Object
Dim swSelMgr As Object
Dim swDispDim As Object
Dim swDim As Object
Dim xlApp As Object
Dim xlWorkbook As Object
Dim xlSheet As Object
Dim i As Integer
Dim j As Integer
Dim tolMin As Double
Dim tolMax As Double
Dim value As Double
Dim valueMin As Double
Dim valueMax As Double
Dim itMin As Double
Dim itMax As Double

' Créer une instance de SolidWorks (Late Binding)
Set swApp = CreateObject("SldWorks.Application")
Set swModel = swApp.ActiveDoc

' Vérification si un dessin est actif
If swModel Is Nothing Then
    MsgBox "Veuillez ouvrir un dessin 2D avant d'exécuter la macro.", vbExclamation
    Exit Sub
End If

' Vérification du type de document
If swModel.GetType <> 3 Then ' 3 correspond à swDocDRAWING
    MsgBox "Cette macro fonctionne uniquement sur un dessin 2D.", vbExclamation
    Exit Sub
End If

Set swDraw = swModel
Set swSelMgr = swModel.SelectionManager

' Créer une instance d'Excel (Late Binding)
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application") ' Vérifier si Excel est ouvert
If xlApp Is Nothing Then
    Set xlApp = CreateObject("Excel.Application") ' Ouvrir Excel si ce n'est pas le cas
End If
On Error GoTo 0

xlApp.Visible = True
Set xlWorkbook = xlApp.Workbooks.Add
Set xlSheet = xlWorkbook.Sheets(1)

' Entêtes Excel pour les propriétés
xlSheet.Cells(1, 1).value = "Référence M3_2D"
xlSheet.Cells(2, 1).value = "Indice"
xlSheet.Cells(3, 1).value = "Description"

' Ajouter une ligne vide après les propriétés
xlSheet.Cells(4, 1).value = ""

' Récupérer les propriétés du modèle (Référence M3_2D, Indice, Description)
Dim customProps As Object
Set customProps = swModel.Extension.CustomPropertyManager("")

Dim refM3_2D As String
Dim indice As String
Dim description As String

' Essayer de récupérer les propriétés en tenant compte des erreurs
On Error Resume Next
refM3_2D = customProps.Get("Référence M3_2D")
If Err.Number <> 0 Then refM3_2D = "Non disponible"

indice = customProps.Get("Indice")
If Err.Number <> 0 Then indice = "Non disponible"

description = customProps.Get("Description")
If Err.Number <> 0 Then description = "Non disponible"
On Error GoTo 0

' Ajouter les propriétés dans Excel
xlSheet.Cells(1, 2).value = refM3_2D
xlSheet.Cells(2, 2).value = indice
xlSheet.Cells(3, 2).value = description

' Ajouter une ligne vide après les propriétés
xlSheet.Cells(4, 1).value = ""

' Ajouter les en-têtes pour les cotes
xlSheet.Cells(5, 1).value = "Nom de la cote"
xlSheet.Cells(5, 2).value = "Valeur"
xlSheet.Cells(5, 3).value = "IT Min"
xlSheet.Cells(5, 4).value = "IT Max"
xlSheet.Cells(5, 5).value = "Valeur Cote Min"
xlSheet.Cells(5, 6).value = "Valeur Cote Max"

' Vérifier si des cotes sont sélectionnées
Dim nbCotes As Integer
nbCotes = swSelMgr.GetSelectedObjectCount()

If nbCotes = 0 Then
    MsgBox "Veuillez sélectionner des cotes avant d'exécuter la macro.", vbExclamation
    Exit Sub
End If

' Parcours des cotes sélectionnées
i = 6 ' Commencer à la ligne 6 après les propriétés, la ligne vide et les en-têtes
Dim ent As Object
For j = 1 To nbCotes
    Set ent = swSelMgr.GetSelectedObject6(j, -1)
    
    ' Vérifier si l'entité sélectionnée est une cote
    If Not ent Is Nothing Then
        If TypeOf ent Is SldWorks.DisplayDimension Then
            Set swDispDim = ent
            Set swDim = swDispDim.GetDimension
            
            ' Vérification de swDim avant d’accéder à ses valeurs
            If Not swDim Is Nothing Then
                ' Récupérer la valeur de la cote
                value = swDim.value
                
                Dim swDimTol As SldWorks.DimensionTolerance
                Set swDimTol = swDim.Tolerance
                If swDimTol.Type <> swTolType_e.swTolNONE Then
                Debug.Print swDimTol.GetMinValue * 1000
                Debug.Print swDimTol.GetMaxValue * 1000
                End If
                
                ' Calcul des valeurs min et max de la cote
                valueMin = value + (swDimTol.GetMinValue * 1000)
                valueMax = value + (swDimTol.GetMaxValue * 1000)
                
                ' Récupérer les tolérances IT (si disponibles)
                On Error Resume Next
                itMin = swDim.Tolerance.GetMinValue * 1000 '.itMin
                itMax = swDim.Tolerance.GetMaxValue * 1000 '.itMax
                On Error GoTo 0
                
                ' Si les tolérances IT ne sont pas disponibles, les assigner à 0
                If IsError(itMin) Then itMin = 0
                If IsError(itMax) Then itMax = 0
                
                ' Exporter la cote, sa valeur, les tolérances IT et les valeurs min et max dans Excel
                xlSheet.Cells(i, 1).value = swDim.FullName ' Nom de la cote
                xlSheet.Cells(i, 2).value = Round(value, 2) ' Valeur de la cote
                xlSheet.Cells(i, 3).value = Round(itMin, 2) ' Tolérance IT Min
                xlSheet.Cells(i, 4).value = itMax ' Tolérance IT Max
                xlSheet.Cells(i, 5).value = Round(valueMin, 2) ' Valeur min de la cote
                xlSheet.Cells(i, 6).value = Round(valueMax, 2) ' Valeur max de la cote
                
                i = i + 1
            Else
                Debug.Print "Erreur : swDim est null pour un élément sélectionné."
            End If
        Else
            Debug.Print "L'élément sélectionné n'est pas une cote."
        End If
    Else
        Debug.Print "Erreur : ent est null pour l'élément " & j
    End If
Next j

' Ajuster la largeur de la colonne A en fonction de son contenu
xlSheet.Columns("A:A").AutoFit

MsgBox "Exportation terminée avec succès !", vbInformation
End Sub

Et rappel ne fait jamais confiance aux chats, ils sont sur terre uniquement pour profiter de l’homme!
:dog2::dog2::dog2:Dog power! :rofl: :rofl: :rofl:

3 « J'aime »

Alors là merci beaucoup!! ça marche (presque :grin:)

Déjà, correction faite pour le formatage de mon post initial, mes plus plates excuses, c’est vrai que c’est bien plus lisible maintenant.

Etant un néophyte complet en VBA, chat GPT (et consort) est plutôt utile, me permettant de faire des codes que je serais bien en peine d’écrire par moi même, en tout cas dans un délai raisonnable. Après plusieurs itérations, on arrive souvent (pas tout le temps) à un résultat potable. et comme j’essaye un minimum de comprendre ce qu’il fait (et là merci l’ajout en auto des commentaires dans le code), je me dit que je progresse un peu, à force :sweat_smile:

Bien vu pour les valeurs *1000, j’aurais du y penser, il m’a déjà fait un coup comme ça au début, en voulant convertir en mm des valeurs qui …étaient déjà en mm :dizzy_face:
Mais de là à imaginer qu’il fallait l’appliquer uniquement sur les tolérances

En corrigeant mon code sur la base du tien, je récupère effectivement les valeurs de tolérances (:+1::clinking_glasses::partying_face:) mais… ça ne marche pas bien pour les tolérances symétriques.

Si ma cote n’a pas de tolérance, j’ai bien zéro partout.
Si mon IT est décentré (par exemple +0/+0.15, ou -0.2/+0), ça marche nickel
Mais si j’ai +/-0.15, il ne m’affiche 0.15 que dans la case IT max.

Mais c’est un immense pas en avant, je me bat avec ça depuis ce matin!

Et j’aime pas les chats non plus :grin:


Option Explicit

Sub main()
    ExportCotesVersExcel
End Sub

Sub ExportCotesVersExcel()
    Dim swApp As Object
    Dim swModel As Object
    Dim swDraw As Object
    Dim swSelMgr As Object
    Dim swDispDim As Object
    Dim swDim As Object
    Dim xlApp As Object
    Dim xlWorkbook As Object
    Dim xlSheet As Object
    Dim i As Integer
    Dim j As Integer
    Dim tolMin As Double
    Dim tolMax As Double
    Dim value As Double
    Dim valueMin As Double
    Dim valueMax As Double
    Dim itMin As Double
    Dim itMax As Double
    
    ' Créer une instance de SolidWorks (Late Binding)
    Set swApp = CreateObject("SldWorks.Application")
    Set swModel = swApp.ActiveDoc
    
    ' Vérification si un dessin est actif
    If swModel Is Nothing Then
        MsgBox "Veuillez ouvrir un dessin 2D avant d'exécuter la macro.", vbExclamation
        Exit Sub
    End If
    
    ' Vérification du type de document
    If swModel.GetType <> 3 Then ' 3 correspond à swDocDRAWING
        MsgBox "Cette macro fonctionne uniquement sur un dessin 2D.", vbExclamation
        Exit Sub
    End If
    
    Set swDraw = swModel
    Set swSelMgr = swModel.SelectionManager
    
    ' Créer une instance d'Excel (Late Binding)
    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application") ' Vérifier si Excel est ouvert
    If xlApp Is Nothing Then
        Set xlApp = CreateObject("Excel.Application") ' Ouvrir Excel si ce n'est pas le cas
    End If
    On Error GoTo 0
    
    xlApp.Visible = True
    Set xlWorkbook = xlApp.Workbooks.Add
    Set xlSheet = xlWorkbook.Sheets(1)
    
    ' Entêtes Excel pour les propriétés
    xlSheet.Cells(1, 1).value = "Référence M3_2D"
    xlSheet.Cells(2, 1).value = "Indice"
    xlSheet.Cells(3, 1).value = "Description"
    
    ' Fusionner les cellules B1:F1, B2:F2 et B3:F3 et justifier à gauche
    With xlSheet.Range("B1:F1")
    .Merge
    .HorizontalAlignment = -4131 ' xlLeft
End With
With xlSheet.Range("B2:F2")
    .Merge
    .HorizontalAlignment = -4131 ' xlLeft
End With
With xlSheet.Range("B3:F3")
    .Merge
    .HorizontalAlignment = -4131 ' xlLeft
End With
    
    ' Ajouter une ligne vide après les propriétés
    xlSheet.Cells(4, 1).value = ""
    
    ' Récupérer les propriétés du modèle (Référence M3_2D, Indice, Description)
    Dim customProps As Object
    Set customProps = swModel.Extension.CustomPropertyManager("")

    Dim refM3_2D As String
    Dim indice As String
    Dim description As String
    
    ' Essayer de récupérer les propriétés en tenant compte des erreurs
    On Error Resume Next
    refM3_2D = customProps.Get("Référence M3_2D")
    If Err.Number <> 0 Then refM3_2D = "Non disponible"
    
    indice = customProps.Get("Indice")
    If Err.Number <> 0 Then indice = "Non disponible"
    
    description = customProps.Get("Description")
    If Err.Number <> 0 Then description = "Non disponible"
    On Error GoTo 0
    
    ' Ajouter les propriétés dans Excel
    xlSheet.Cells(1, 2).value = refM3_2D
    xlSheet.Cells(2, 2).value = indice
    xlSheet.Cells(3, 2).value = description
    
    ' Ajouter une ligne vide après les propriétés
    xlSheet.Cells(4, 1).value = ""
    
    ' Ajouter les en-têtes pour les cotes
    xlSheet.Cells(5, 1).value = "Nom de la cote"
    xlSheet.Cells(5, 2).value = "Valeur"
    xlSheet.Cells(5, 3).value = "IT Min"
    xlSheet.Cells(5, 4).value = "IT Max"
    xlSheet.Cells(5, 5).value = "Valeur Cote Min"
    xlSheet.Cells(5, 6).value = "Valeur Cote Max"
    
    ' Vérifier si des cotes sont sélectionnées
    Dim nbCotes As Integer
    nbCotes = swSelMgr.GetSelectedObjectCount()
    
    If nbCotes = 0 Then
        MsgBox "Veuillez sélectionner des cotes avant d'exécuter la macro.", vbExclamation
        Exit Sub
    End If

    ' Parcours des cotes sélectionnées
    i = 6 ' Commencer à la ligne 6 après les propriétés, la ligne vide et les en-têtes
    Dim ent As Object
    For j = 1 To nbCotes
        Set ent = swSelMgr.GetSelectedObject6(j, -1)
        
        ' Vérifier si l'entité sélectionnée est une cote
        If Not ent Is Nothing Then
            If TypeOf ent Is SldWorks.DisplayDimension Then
                Set swDispDim = ent
                Set swDim = swDispDim.GetDimension
                
                ' Vérification de swDim avant d’accéder à ses valeurs
                If Not swDim Is Nothing Then
                    ' Récupérer la valeur de la cote
                      value = swDim.value
                
                Dim swDimTol As SldWorks.DimensionTolerance
                Set swDimTol = swDim.tolerance
                If swDimTol.Type <> swTolType_e.swTolNONE Then
                Debug.Print swDimTol.GetMinValue * 1000
                Debug.Print swDimTol.GetMaxValue * 1000
                End If
                
                '  Calcul des valeurs min et max de la cote
                valueMin = value + (swDimTol.GetMinValue * 1000)
                valueMax = value + (swDimTol.GetMaxValue * 1000)
                
                ' Récupérer les tolérances IT (si disponibles)
                On Error Resume Next
                itMin = swDim.tolerance.GetMinValue * 1000 '.itMin
                itMax = swDim.tolerance.GetMaxValue * 1000 '.itMax
                On Error GoTo 0
                
                ' Si les tolérances IT ne sont pas disponibles, les assigner à 0
                If IsError(itMin) Then itMin = 0
                If IsError(itMax) Then itMax = 0
                
                ' Exporter la cote, sa valeur, les tolérances IT et les valeurs min et max dans Excel
                xlSheet.Cells(i, 1).value = swDim.FullName ' Nom de la cote
                xlSheet.Cells(i, 2).value = Round(value, 2) ' Valeur de la cote
                xlSheet.Cells(i, 3).value = Round(itMin, 2) ' Tolérance IT Min
                xlSheet.Cells(i, 4).value = itMax ' Tolérance IT Max
                xlSheet.Cells(i, 5).value = Round(valueMin, 2) ' Valeur min de la cote
                xlSheet.Cells(i, 6).value = Round(valueMax, 2) ' Valeur max de la cote
                
                i = i + 1
            Else
                Debug.Print "Erreur : swDim est null pour un élément sélectionné."
            End If
        Else
            Debug.Print "L'élément sélectionné n'est pas une cote."
        End If
    Else
        Debug.Print "Erreur : ent est null pour l'élément " & j
    End If
Next j
    
    ' Ajuster la largeur des colonnes pour s'adapter au contenu
    xlSheet.Columns("A:A").AutoFit ' Ajuste la colonne A
    xlSheet.Columns("C:C").AutoFit ' Ajuste la colonne C (IT Min)
    xlSheet.Columns("D:D").AutoFit ' Ajuste la colonne D (IT Max)
    xlSheet.Columns("E:E").AutoFit ' Ajuste la colonne E (Valeur Cote Min)
    xlSheet.Columns("F:F").AutoFit ' Ajuste la colonne F (Valeur Cote Max)
    
    MsgBox "Exportation terminée avec succès !", vbInformation
End Sub

Bonjour

Je n’ai pas decodé tout le code donc ce ne sont peut-être pas les bonnes variables mais c’est pour illustrer l’idée.

Tu dois pouvoir t’en sortir avec une comparaison du style :
si la case min est vide c’est qu’elle est le négatif de max (si itMax n’est pas null non plus), donc on lui dit d’afficher la même valeur que max mais avec le signe moins.

If (IsNull(itMin) & Not IsNull(itMax)) Then itMin = -(itMax)

ou

If (IsNull(itMin) & Not IsNull(itMax)) Then itMin = itMax-(itMax*2)

oui mais si tu as une tolérance bilatérale, du genre +0/+0.2? :grin:

Alors c’est que itMin vaut 0, et n’est donc pas null, la condition est alors « ignorée ».

je l’avais pas vu comme ça, à tester, effectivement :+1:

Sauf erreur de ma part, tu dois pouvoir l’intégrer ainsi :

xlSheet.Cells(i, 3).value = Round(IIf((IsNull(itMin) & Not IsNull(itMax)), itMax-(itMax*2), itMin), 2) ' Tolérance IT Min

à la place de

xlSheet.Cells(i, 3).value = Round(itMin, 2) ' Tolérance IT Min

décryptage :
SI itMin est Null et que itMax est non Null, ALORS la cellule itMin vaut -itMax arrondi, SINON la cellule itMin vaut itMin arrondi

1 « J'aime »

ça ne fonctionne pas, la macro plante avec ce bout de code. Mais tétu (et feignant :grin:) je suis, j’ai donc réinjecté la macro corrigé dans ChatGPT qui m’a proposé de rajouter ça après la récupération des IT min et IT max:


' Vérifier si la tolérance est symétrique et corriger itMin
If swDimTol.Type = swTolType_e.swTolSYMMETRIC Then
    itMin = -itMax
End If

Et ça fonctionne! je récupère bien tout!

Merci à tous les deux pour votre aide!

Pour ceux qui souhaiterais faire une macro similaire, voilà le code complet :

Option Explicit

Sub main()
    ExportCotesVersExcel
End Sub

Sub ExportCotesVersExcel()
    Dim swApp As Object
    Dim swModel As Object
    Dim swDraw As Object
    Dim swSelMgr As Object
    Dim swDispDim As Object
    Dim swDim As Object
    Dim xlApp As Object
    Dim xlWorkbook As Object
    Dim xlSheet As Object
    Dim i As Integer
    Dim j As Integer
    Dim tolMin As Double
    Dim tolMax As Double
    Dim value As Double
    Dim valueMin As Double
    Dim valueMax As Double
    Dim itMin As Double
    Dim itMax As Double
    
    ' Créer une instance de SolidWorks (Late Binding)
    Set swApp = CreateObject("SldWorks.Application")
    Set swModel = swApp.ActiveDoc
    
    ' Vérification si un dessin est actif
    If swModel Is Nothing Then
        MsgBox "Veuillez ouvrir un dessin 2D avant d'exécuter la macro.", vbExclamation
        Exit Sub
    End If
    
    ' Vérification du type de document
    If swModel.GetType <> 3 Then ' 3 correspond à swDocDRAWING
        MsgBox "Cette macro fonctionne uniquement sur un dessin 2D.", vbExclamation
        Exit Sub
    End If
    
    Set swDraw = swModel
    Set swSelMgr = swModel.SelectionManager
    
    ' Créer une instance d'Excel (Late Binding)
    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application") ' Vérifier si Excel est ouvert
    If xlApp Is Nothing Then
        Set xlApp = CreateObject("Excel.Application") ' Ouvrir Excel si ce n'est pas le cas
    End If
    On Error GoTo 0
    
    xlApp.Visible = True
    Set xlWorkbook = xlApp.Workbooks.Add
    Set xlSheet = xlWorkbook.Sheets(1)
    
    ' Entêtes Excel pour les propriétés
    xlSheet.Cells(1, 1).value = "Référence M3_2D"
    xlSheet.Cells(2, 1).value = "Indice"
    xlSheet.Cells(3, 1).value = "Description"
    
    ' Fusionner les cellules B1:F1, B2:F2 et B3:F3 et justifier à gauche
    With xlSheet.Range("B1:F1")
    .Merge
    .HorizontalAlignment = -4131 ' xlLeft
End With
With xlSheet.Range("B2:F2")
    .Merge
    .HorizontalAlignment = -4131 ' xlLeft
End With
With xlSheet.Range("B3:F3")
    .Merge
    .HorizontalAlignment = -4131 ' xlLeft
End With
    
    ' Ajouter une ligne vide après les propriétés
    xlSheet.Cells(4, 1).value = ""
    
    ' Récupérer les propriétés du modèle (Référence M3_2D, Indice, Description)
    Dim customProps As Object
    Set customProps = swModel.Extension.CustomPropertyManager("")

    Dim refM3_2D As String
    Dim indice As String
    Dim description As String
    
    ' Essayer de récupérer les propriétés en tenant compte des erreurs
    On Error Resume Next
    refM3_2D = customProps.Get("Référence M3_2D")
    If Err.Number <> 0 Then refM3_2D = "Non disponible"
    
    indice = customProps.Get("Indice")
    If Err.Number <> 0 Then indice = "Non disponible"
    
    description = customProps.Get("Description")
    If Err.Number <> 0 Then description = "Non disponible"
    On Error GoTo 0
    
    ' Ajouter les propriétés dans Excel
    xlSheet.Cells(1, 2).value = refM3_2D
    xlSheet.Cells(2, 2).value = indice
    xlSheet.Cells(3, 2).value = description
    
    ' Ajouter une ligne vide après les propriétés
    xlSheet.Cells(4, 1).value = ""
    
    ' Ajouter les en-têtes pour les cotes
    xlSheet.Cells(5, 1).value = "Nom de la cote"
    xlSheet.Cells(5, 2).value = "Valeur"
    xlSheet.Cells(5, 3).value = "IT Min"
    xlSheet.Cells(5, 4).value = "IT Max"
    xlSheet.Cells(5, 5).value = "Valeur Cote Min"
    xlSheet.Cells(5, 6).value = "Valeur Cote Max"
    
    ' Vérifier si des cotes sont sélectionnées
    Dim nbCotes As Integer
    nbCotes = swSelMgr.GetSelectedObjectCount()
    
    If nbCotes = 0 Then
        MsgBox "Veuillez sélectionner des cotes avant d'exécuter la macro.", vbExclamation
        Exit Sub
    End If

    ' Parcours des cotes sélectionnées
    i = 6 ' Commencer à la ligne 6 après les propriétés, la ligne vide et les en-têtes
    Dim ent As Object
    For j = 1 To nbCotes
        Set ent = swSelMgr.GetSelectedObject6(j, -1)
        
        ' Vérifier si l'entité sélectionnée est une cote
        If Not ent Is Nothing Then
            If TypeOf ent Is SldWorks.DisplayDimension Then
                Set swDispDim = ent
                Set swDim = swDispDim.GetDimension
                
                ' Vérification de swDim avant d’accéder à ses valeurs
                If Not swDim Is Nothing Then
                    ' Récupérer la valeur de la cote
                      value = swDim.value
                
                Dim swDimTol As SldWorks.DimensionTolerance
                Set swDimTol = swDim.tolerance
                If swDimTol.Type <> swTolType_e.swTolNONE Then
                Debug.Print swDimTol.GetMinValue * 1000
                Debug.Print swDimTol.GetMaxValue * 1000
                End If
                
                '  Calcul des valeurs min et max de la cote
                valueMin = value + (swDimTol.GetMinValue * 1000)
                valueMax = value + (swDimTol.GetMaxValue * 1000)
                
                ' Récupérer les tolérances IT (si disponibles)
                On Error Resume Next
                itMin = swDim.tolerance.GetMinValue * 1000 '.itMin
                itMax = swDim.tolerance.GetMaxValue * 1000 '.itMax
                On Error GoTo 0
                
                ' Vérifier si la tolérance est symétrique et corriger itMin
If swDimTol.Type = swTolType_e.swTolSYMMETRIC Then
    itMin = -itMax
End If
                
                ' Si les tolérances IT ne sont pas disponibles, les assigner à 0
                If IsError(itMin) Then itMin = 0
                If IsError(itMax) Then itMax = 0
                
                ' Exporter la cote, sa valeur, les tolérances IT et les valeurs min et max dans Excel
                xlSheet.Cells(i, 1).value = swDim.FullName ' Nom de la cote
                xlSheet.Cells(i, 2).value = Round(value, 2) ' Valeur de la cote
                xlSheet.Cells(i, 3).value = Round(itMin, 2) ' Tolérance IT Min
                xlSheet.Cells(i, 4).value = itMax ' Tolérance IT Max
                xlSheet.Cells(i, 5).value = Round(valueMin, 2) ' Valeur min de la cote
                xlSheet.Cells(i, 6).value = Round(valueMax, 2) ' Valeur max de la cote
                
                i = i + 1
            Else
                Debug.Print "Erreur : swDim est null pour un élément sélectionné."
            End If
        Else
            Debug.Print "L'élément sélectionné n'est pas une cote."
        End If
    Else
        Debug.Print "Erreur : ent est null pour l'élément " & j
    End If
Next j
    
    ' Ajuster la largeur des colonnes pour s'adapter au contenu
    xlSheet.Columns("A:A").AutoFit ' Ajuste la colonne A
    xlSheet.Columns("C:C").AutoFit ' Ajuste la colonne C (IT Min)
    xlSheet.Columns("D:D").AutoFit ' Ajuste la colonne D (IT Max)
    xlSheet.Columns("E:E").AutoFit ' Ajuste la colonne E (Valeur Cote Min)
    xlSheet.Columns("F:F").AutoFit ' Ajuste la colonne F (Valeur Cote Max)
    
    MsgBox "Exportation terminée avec succès !", vbInformation
End Sub




3 « J'aime »

J’avais prévenu que j’avais lu le code en diagonal et qu’il faudrait adapter l’idée.

Mon dernier bout de code n’est sans doute qu’une syntax error, mais le premier aurait dû fonctionner. Mais certes, tester le type au lieu de la valeur est effectivement sans doute plus propre.