Programowanie w Solidworks VBA

Winny10 · 18 Lipiec 2024 08:08

Witam

Pracuję nad projektem programistycznym, którego celem jest ręczne wybranie kilku wymiarów, które następnie zostaną obliczone według wzoru predefiniowanego w programie. Mam dwa problemy, których nie potrafię rozwiązać.

Podczas wybierania wymiarów w modelu 3D chcę pobrać maksymalne i minimalne wartości wymiarów. Obecnie cena maksymalna jest dobrze odzyskana, ale cena, która powinna być na poziomie minimum, wyświetla cenę nominalną. M

Tolerancje są w formacie " symetrycznym " i jedynym rozwiązaniem, jakie znalazłem, aby to zadziałało, jest umieszczenie moich tolerancji w formacie " dwustronnym ". Mam jednak zbyt wiele szans i nie mogę sobie pozwolić na ich wszystkie zmianę. W związku z tym musiałby działać również dla tolerancji w formacie " symetrycznym ". Dołączam mój program do tej wiadomości (zmieniłem kilka ustawień ze względu na prywatność, co nie powinno Ci przeszkadzać w odpowiadaniu na moje pytanie).
2. Jak odzyskać wartość nominalną kwotowania?

Dziękuję za pomoc!

Maclane · 18 Lipiec 2024 08:22

Witam;

Czy mógłbyś edytować swój kod za pomocą tagów forum?

(Nigdy nie pobieram nieznanego kodu...)

Pozdrowienia.

Winny10 · 18 Lipiec 2024 08:24

Witaj ekspert forum, tak chętnie, tylko jak to zrobić, skoro jest w 3 częściach? (Arkusz, Moduł, Moduł klasy)

Bob_2000 · 18 Lipiec 2024 09:45

Publikujesz w 3 oddzielnych częściach i określasz, gdzie idzie kod

Bob_2000 · 18 Lipiec 2024 09:48

kod nie jest dobrze sformatowany, przeczytaj ponownie, tagi nie są we właściwym miejscu

Winny10 · 18 Lipiec 2024 09:51

Formularz użytkownika;

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 · 18 Lipiec 2024 09:52

Moduł

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 · 18 Lipiec 2024 09:52

Moduł klasowy

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 · 18 Lipiec 2024 09:55

Możesz umieścić makro w PJ, pomoże to również, jeśli możemy mieć wizualizację w naszych solidworks

Winny10 · 18 Lipiec 2024 10:49

Co oznacza PJ? Przepraszam za brak wiedzy...

remrem · 18 Lipiec 2024 11:16

Jest dołączony.

Domyślam się, że zajrzałeś do tej pomocy: Pobierz przykład tolerancji wymiarów (VBA) - 2023 - Pomoc SOLIDWORKS API

Twoja zmienna " OkTol " jest używana dwukrotnie dla wartości Min i Max, więc jej wartość jest zastępowana. W pomocy typem jest Long.

Winny10 · 18 Lipiec 2024 11:48

Nie patrzyłem na ten link, nie wiedziałem o tym. Przyjrzę się temu, dziękuję. To właśnie Maclane pomógł mi w programowaniu celui.ci.

Maclane · 18 Lipiec 2024 11:59

Jesteś napompowany... Przekierowałem Cię na stronę, która wydawała mi się istotna... Nie planowałem niczego w tym celu.
Zobaczyć:

I nie jestem pewien, czy doceniam użyty ton (sarkazm?)

Winny10 · 18 Lipiec 2024 12:09

Trafiłem na niewłaściwą osobę, przepraszam! Pomyliłem go z innym użytkownikiem forum. W żadnym wypadku nie jesteś osobą, o której myślałem ^^. Życzę Ci miłego dnia. PS: Do ludzi w Twoim typie, rozgoryczonych, nie proszę o pomoc, dziękuję.

sbadenis · 18 Lipiec 2024 13:07

PS to może być za dużo, prawda?
@Maclane może źle zinterpretować wiadomość, ale gorzki jak na osobę, która spędza swój czas na pomaganiu innym (w tej chwili główny współpracownik nr 1), bardzo w to wątpię:

Winny10 · 18 Lipiec 2024 13:10

Może to przesada, ale jego przekaz wydał mi się bardzo negatywny, wiedząc, że nie mam za nim złych intencji... Ale nie ma problemu, jesteśmy po to, aby rozwiązywać problemy, pomagać sobie nawzajem, a nie dyskutować na ten temat