Solidworks VBA Programmeren

Winny10 · 18 juli 2024 om 08:08

Hallo

Ik werk aan een programmeerproject dat tot doel heeft handmatig verschillende dimensies te selecteren, die vervolgens worden berekend volgens een formule die vooraf in het programma is gedefinieerd. Ik heb twee problemen die ik niet kan oplossen.

Bij het selecteren van de afmetingen in het 3D-model wil ik de maximale en minimale waarden van de afmetingen ophalen. Momenteel is de maximumprijs goed hersteld, maar de prijs die op het minimum zou moeten liggen, geeft de nominale prijs weer. M

Toleranties zijn in " symmetrisch " formaat en de enige oplossing die ik heb gevonden om dit te laten werken is om mijn toleranties in " bilateraal " formaat te zetten. Ik heb echter te veel kansen en ik kan het me niet veroorloven om ze allemaal te veranderen. Het zou dus ook moeten werken voor toleranties in " symmetrisch " formaat. Ik voeg mijn programma toe aan dit bericht (ik heb een paar instellingen gewijzigd om privacyredenen, wat je niet zou moeten storen bij het beantwoorden van mijn vraag).
2. Hoe krijg ik de nominale waarde van een offerte terug?

Bedankt voor je hulp!

Maclane · 18 juli 2024 om 08:22

Hallo;

Zou je je code kunnen bewerken met behulp van de forumtags?

(Ik download nooit een onbekende code...)

Vriendelijke groeten.

Winny10 · 18 juli 2024 om 08:24

Hallo forumexpert, ja graag, hoe doe ik het, want het bestaat uit 3 delen? (Blad, Module, Klasse Module)

Bob_2000 · 18 juli 2024 om 09:45

Je post in 3 losse delen en je geeft aan waar de code naartoe gaat

Bob_2000 · 18 juli 2024 om 09:48

De code is niet goed opgemaakt, lees nog eens de tags staan niet op de juiste plaats

Winny10 · 18 juli 2024 om 09:51

Gebruikersformulier;

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

Module in de klas

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 juli 2024 om 09:55

Je kunt de macro in PJ zetten, het zal ook helpen als we het visuele in onze solidworks kunnen hebben

Winny10 · 18 juli 2024 om 10:49

Wat betekent PJ? Sorry voor mijn gebrek aan kennis...

remrem · 18 juli 2024 om 11:16

Het is bijgevoegd.

Ik denk dat je naar deze hulp hebt gekeken: Voorbeeld van dimensietolerantie ophalen (VBA) - 2023 - SOLIDWORKS API Help

Uw variabele " OkTol " wordt twee keer gebruikt voor de Min- en Max-waarde, dus de waarde wordt vervangen. In de help is het type lang.

Winny10 · 18 juli 2024 om 11:48

Ik heb niet naar deze link gekeken, ik kende hem niet. Ik zal er eens naar kijken, dank je. Het was Maclane die me hielp met het programmeren van celui.ci.

Maclane · 18 juli 2024 om 11:59

Je bent opgeblazen... Ik heb je doorverwezen naar de site die mij relevant leek... Ik heb niets gepland voor dit doel.
Om te zien:

En ik weet niet zeker of ik de gebruikte toon waardeer (sarcasme?)

Winny10 · 18 juli 2024 om 12:09

Ik heb de verkeerde persoon, sorry! Ik verwarde het met een andere gebruiker van het forum. Je bent zeker niet de persoon aan wie ik dacht ^^. Fijne dag voor jou. PS: Aan mensen van jouw type, verbitterd, ik vraag niet om hulp, dank je.

sbadenis · 18 juli 2024 om 13:07

De PS is misschien te veel, nietwaar?
@Maclane heb misschien een bericht verkeerd geïnterpreteerd, maar bitter voor iemand die zijn tijd besteedt aan het helpen van anderen (Topbijdrager nr. 1 op dit moment), betwijfel ik het ten zeerste:

Winny10 · 18 juli 2024 om 13:10

Misschien is het overdreven, maar ik vond zijn bericht erg negatief, wetende dat ik er geen slechte bedoelingen achter had... Maar geen probleem, we zijn hier om problemen op te lossen, om elkaar te helpen en niet om erover te discussiëren