Solidworks Programmation VBA

Winny10 · Juillet 18, 2024, 8:08

Bonjour,

Je travaille sur un projet de programmation dont le but est de sélectionner manuellement plusieurs cotes, qui seront ensuite calculées en fonction d’une formule prédéfinie dans le programme. Je rencontre deux problèmes que je n’arrive pas à résoudre.

Lors de la sélection des cotes dans le modèle 3D, je souhaite récupérer les valeurs maxi et mini des cotes. Actuellement, la cote au maxi est bien récupérée, mais la cote qui est censée être au mini affiche la cote nominale. M

es tolérances sont en format « symétrique » et la seule solution que j’ai trouvée pour que cela fonctionne est de mettre mes tolérances en format « bilatéral ». Cependant, j’ai trop de cotes et je ne peux pas me permettre de toutes les modifier. Il faudrait donc que cela fonctionne également pour les tolérances en format « symétrique ». Je joins à ce message mon programme (j’ai modifié quelques paramètres pour des raisons de confidentialité, ce qui ne devrait pas vous gêner pour répondre à ma question).
2. Comment faire pour récupérer la valeur nominale d’une cote ?

Merci pour votre aide !

Maclane · Juillet 18, 2024, 8:22

Bonjour;

Pourriez-vous éditer votre code en utilisant les balises du forum ?

(je ne télécharge jamais un code inconnu…)

Cordialement.

Winny10 · Juillet 18, 2024, 8:24

Bonjour l’expert du forum, oui volontiers, juste je fais comment vu qu’il est en 3 parties ? (Feuille, module, module de classe)

Bob_2000 · Juillet 18, 2024, 9:45

tu poste en 3 parties séparées et tu précise ou va le code

Bob_2000 · Juillet 18, 2024, 9:48

le code n’est pas bien formaté, relis toi les balises ne sont pas au bon endroit

Winny10 · Juillet 18, 2024, 9:51

Userform ;

Option Explicit

#Const DEBOG = True

Const min As Integer = 0
Const max As Integer = 1

Private Sub CommandButton1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim vlrMin As Double
    Dim vlrMax As Double
    Dim VlrNom As Double

    vlrMin = 0
    
    vlrMax = 0
    vlrMax = vlrMin + prm(8).minMax(0) - prm(2).minMax(1) - prm(3).minMax(0) + prm(5).minMax(0) / Cos((90 - prm(6).minMax(0)) * pi / 180#)
    VlrNom = Round((vlrMin + vlrMax))
    
    ' Mise à jour des TextBox avec les résultats formatés
    TextBox20.Text = Format(vlrMin, "###.000")
    TextBox22.Text = Format(vlrMax, "###.000")
End Sub

Private Sub CommandButton2_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim i As Integer
    ' Réinitialisation des valeurs des paramètres et des TextBox associées
    For i = 1 To 8
        With prm(i)
            .minMax(0) = 0#
            .minMax(1) = 0#
            .tBox(1).Text = ""
            .tBox(2).Text = ""
        End With
    Next i
    TextBox20.Text = ""
    TextBox22.Text = ""
    TextBox1.SetFocus
End Sub

Private Sub CommandButton3_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    End
End Sub

Function chaineSaisie(nInit As Integer)
    While nInit <= 8
        If Esc Then Exit Function
        If prm(nInit).TimerExecute(True) Then
            nInit = nInit + 1
        Else
            Exit Function
        End If
        DoEvents
        Esc = False
    Wend
End Function

Private Sub Label1_Click()

End Sub


Private Sub Label4_Click()

End Sub

' Gestion des événements Enter des TextBox
Private Sub TextBox1_Enter()
    chaineSaisie (1)
End Sub

Private Sub TextBox11_Enter()
    chaineSaisie (1)
End Sub

Private Sub TextBox2_Enter()
    chaineSaisie (2)
End Sub

Private Sub TextBox12_Enter()
    chaineS

Winny10 · Juillet 18, 2024, 9:52

Module

Option Explicit



' ******************************************************************************
'
' ******************************************************************************
    
Public Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
    
Public swApp As Object
Public swAssemb As AssemblyDoc
Public swSelectMgr As SelectionMgr
Public prm(1 To 8) As ClPrm
Public Esc As Boolean

Public Const pi = 3.14159265358979

Function createPrm()
Dim i As Integer
    For i = 1 To 8
        Set prm(i) = New ClPrm
    Next i
    With UserForm1
        prm(1).initValuesPrm .TextBox1, .TextBox11, 1000#, 0
        prm(2).initValuesPrm .TextBox2, .TextBox12, 1000#, 1
        prm(3).initValuesPrm .TextBox3, .TextBox13, 180# / pi, 2
        prm(4).initValuesPrm .TextBox4, .TextBox14, 1000#, 3
        prm(5).initValuesPrm .TextBox5, .TextBox15, 1000#, 4
        prm(6).initValuesPrm .TextBox6, .TextBox16, 1000#, 5
        prm(7).initValuesPrm .TextBox7, .TextBox17, 1000#, 6
        prm(8).initValuesPrm .TextBox8, .TextBox18, 1000#, 7
    End With
End Function



Sub main()
    Set swApp = Application.SldWorks
    If swApp.ActiveDoc Is Nothing Then
        MsgBox "Un assemblage doit être ouvert."
        Exit Sub
    End If
    If swApp.ActiveDoc.GetType <> swDocASSEMBLY Then
        MsgBox "Un assemblage doit être ouvert."
        Exit Sub
    End If
    Set swAssemb = swApp.ActiveDoc
    Set swSelectMgr = swAssemb.SelectionManager
    
    With UserForm1
        .Show
        .Repaint
    End With
    createPrm
    swAssemb.ClearSelection2 True
End Sub

Winny10 · Juillet 18, 2024, 9:52

Module de classe

Option Explicit

Private pIndice As Integer
Private pCoef As Double

Private pMinMax(1) As Double
Private pBox(1 To 2) As MSForms.TextBox
Private pTimerEnabled As Boolean

Public Function initValuesPrm(ByRef editLoc1 As TextBox, ByRef editLoc2 As TextBox, coefLoc As Double, no As Integer) As Boolean
        pIndice = no
        pCoef = coefLoc
        Set pBox(1) = editLoc1
        Set pBox(2) = editLoc2
        pMinMax(0) = 0#
        pMinMax(1) = 0#
End Function

Public Property Get BkColor(no As Integer) As Long
    BkColor = pBox(no).BackColor
End Property

Public Property Let BkColor(no As Integer, clr As Long)
    pBox(no).BackColor = clr
End Property

Public Property Get tBox(no As Integer) As TextBox
    Set tBox = pBox(no)
End Property

Public Property Get minMax(no As Integer) As Double
    minMax = pMinMax(no)
End Property

Public Property Let minMax(no As Integer, vlr As Double)
    pMinMax(no) = vlr
End Property

Public Property Get coef() As Double
    coef = pCoef
End Property

Public Property Let coef(vlr As Double)
    pCoef = vlr
End Property

Public Property Get TimerEnabled() As Boolean
    TimerEnabled = pTimerEnabled
End Property

Public Property Let TimerEnabled(bool As Boolean)
    pTimerEnabled = bool
End Property

Public Function selectCote() As Boolean
Dim OkTol As Integer
Dim swDisplayDimension As DisplayDimension
Dim swDimension As Dimension
Dim swDimensionTolerance As DimensionTolerance
Dim vlr As Double

    selectCote = False
    DoEvents
        pBox(1).BackColor = &HC0C0FF
        pBox(2).BackColor = &HC0C0FF
        If swSelectMgr.GetSelectedObjectCount2(-1) > 0 Then
            If swSelectMgr.GetSelectedObjectType3(1, -1) = swSelDIMENSIONS Then
                Set swDisplayDimension = swAssemb.SelectionManager.GetSelectedObject6(1, -1)
                Set swDimension = swDisplayDimension.GetDimension2(0)
                Set swDimensionTolerance = swDimension.Tolerance
                OkTol = swDimensionTolerance.GetMinValue2(vlr)
                pMinMax(0) = pCoef * vlr + swDimension.Value
                OkTol = swDimensionTolerance.GetMaxValue2(vlr)
                pMinMax(1) = pCoef * vlr + swDimension.Value
                pBox(1).Text = Format(pMinMax(0), "###.000")
                pBox(2).Text = Format(pMinMax(1), "###.000")
                swAssemb.ClearSelection2 True
                selectCote = True
            End If
        End If
End Function

Public Function TimerExecute(OKtimer As Boolean) As Boolean
    Dim start As Double
    Dim nTimer As Integer
    Dim PauseTime As Double

    TimerExecute = False
    nTimer = 0
    PauseTime = 0.25
    pTimerEnabled = OKtimer
            If pTimerEnabled Then
                pBox(1).BackColor = &HC0C0FF
                pBox(2).BackColor = &HC0C0FF
                Do
                    start = Timer
                    Do While (Timer - start < PauseTime) And (Not Esc) 'And (pTimerEnabled)
                        DoEvents
                        Esc = GetAsyncKeyState(27)
                    Loop
                    nTimer = nTimer + 1
                    UserForm1.TextBox99.Text = nTimer
                    If nTimer >= 180 Then
                        OKtimer = False
                    Else
                        If selectCote Then
                            OKtimer = False
                            TimerExecute = True
                        End If
                    End If
                Loop Until Not OKtimer
            End If
            pBox(1).BackColor = &H80000005
            pBox(2).BackColor = &H80000005
            pTimerEnabled = OKtimer
            Esc = False

End Function

Bob_2000 · Juillet 18, 2024, 9:55

tu peux mettre la macro en pj ca aidera aussi si on peut avoir le visuel dans notre solidworks

Winny10 · Juillet 18, 2024, 10:49

Que signifie PJ ? Désolé pour mon manque de connaissance…

remrem · Juillet 18, 2024, 11:16

C’est en pièce jointe.

J’imagine que tu as regardé cette aide : Get Dimension Tolerance Example (VBA) - 2023 - SOLIDWORKS API Help

Ta variable « OkTol » est utilisée deux fois pour la valeur Min et Max donc sa valeur est remplacée. Dans l’aide, le type est Long.

Winny10 · Juillet 18, 2024, 11:48

Je n’ai pas regardé ce lien, je le connaissais pas. Je vais y jeté un œil merci. C’était Maclane qui m’avait aidé pour la programmation de celui.ci.

Maclane · Juillet 18, 2024, 11:59

T’es gonflé… je t’ai orienté vers le site qui me semblais pertinent… je n’ai rien programmé dans cet objectif.
Voir:

Et je ne suis pas certain d’apprécier le ton employé (Sarcasme ?)

Winny10 · Juillet 18, 2024, 12:09

Je me suis trompé de personne, désolé ! J’ai confondu avec un autre utilisateur du forum. Tu n’es de loin pas la personne à qui je pensais ^^. Bonne journée à toi. PS : Aux personnes de ton type, aigries, je ne demande pas d’aide, merci.

sbadenis · Juillet 18, 2024, 1:07

Le PS est peut être de trop, non?
@Maclane peu avoir mal interprété un message, mais aigri pour une personne qui passe son temps à en aider d’autres (Top contributeur N°1 en ce moment), j’en doute beaucoup:

Winny10 · Juillet 18, 2024, 1:10

Peut-être que c’est exagéré, mais j’ai trouvé son message très négatif sachant que je n’avais aucune mauvaise intention derrière… Mais pas grave, nous sommes là pour résoudre des problèmatiques, s’aider et non débattre par rapport à cela