Solidworks VBA-Programmierung

Hallo

Ich arbeite an einem Programmierprojekt, dessen Zweck es ist, mehrere Dimensionen manuell auszuwählen, die dann nach einer im Programm vordefinierten Formel berechnet werden. Ich habe zwei Probleme, die ich nicht lösen kann.

  1. Bei der Auswahl der Bemaßungen im 3D-Modell möchte ich die Maximal- und Minimalwerte der Bemaßungen abrufen. Derzeit ist der Höchstpreis gut erholt, aber der Preis, der auf dem Minimum liegen sollte, zeigt den Nominalpreis an. M

Die Toleranzen sind im " symmetrischen " Format und die einzige Lösung, die ich gefunden habe, um dies zu erreichen, besteht darin, meine Toleranzen im " bilateralen  " Format zu setzen. Allerdings habe ich zu viele Chancen und kann es mir nicht leisten, sie alle zu ändern. Es müsste also auch mit Toleranzen im " symmetrischen " Format arbeiten. Ich hänge mein Programm an diese Nachricht an (ich habe aus Datenschutzgründen einige Einstellungen geändert, was Sie bei der Beantwortung meiner Frage nicht stören sollte).
2. Wie kann ich den Nennwert eines Angebots wiederherstellen?

Danke für Ihre Hilfe!

Hallo;

Könnten Sie Ihren Code mit den Foren-Tags bearbeiten?
image
(Ich lade nie einen unbekannten Code herunter...)

Herzliche Grüße.

Hallo Forenexperte, ja gerne, wie mache ich das, da es in 3 Teilen ist? (Blatt, Modul, Klassenmodul)

Sie posten in 3 separaten Teilen und geben an, wohin der Code geht

1 „Gefällt mir“

Der Code ist nicht gut formatiert, lesen Sie erneut die Tags sind nicht an der richtigen Stelle

1 „Gefällt mir“

Benutzerformular;

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

Modul

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


Präsenz-Modul

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


Sie können das Makro in PJ einfügen, es wird auch hilfreich sein, wenn wir das Visuelle in unserem SolidWorks haben können

Was bedeutet PJ? Entschuldigung für mein mangelndes Wissen...

Es ist angehängt.

Ich nehme an, Sie haben sich diese Hilfe angesehen: Abrufen eines Beispiels für eine Bemaßungstoleranz (VBA) - 2023 - SOLIDWORKS API-Hilfe

Die Variable " OkTol " wird zweimal für den Min- und Max-Wert verwendet, sodass ihr Wert ersetzt wird. In der Hilfe ist der Typ Long.

1 „Gefällt mir“

Ich habe mir diesen Link nicht angesehen, ich wusste es nicht. Ich werde es mir ansehen, danke. Es war Maclane, der mir bei der Programmierung von celui.ci half.

Du bist aufgeblasen... Ich habe Sie auf die Seite verwiesen, die mir relevant erschien... Zu diesem Zweck habe ich nichts geplant.
Sehen:

Und ich bin mir nicht sicher, ob ich den verwendeten Ton (Sarkasmus?)

Ich habe die falsche Person erwischt, tut mir leid! Ich habe es mit einem anderen Benutzer des Forums verwechselt. Du bist auf keinen Fall die Person, an die ich gedacht habe ^^. Einen schönen Tag noch. PS: An Leute Ihrer Art, verbittert, ich bitte nicht um Hilfe, danke.

Die PS könnten zu viel sein, nicht wahr?
@Maclane vielleicht eine Nachricht falsch interpretiert habe, aber bitter für eine Person, die ihre Zeit damit verbringt, anderen zu helfen (Top-Mitwirkender Nr. 1 im Moment), bezweifle ich sehr:
image

1 „Gefällt mir“

Vielleicht ist es übertrieben, aber ich fand seine Botschaft sehr negativ, da ich wusste, dass ich keine bösen Absichten dahinter hatte... Aber kein Problem, wir sind hier, um Probleme zu lösen, uns gegenseitig zu helfen und nicht um darüber zu debattieren :grin: