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.
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?
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
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
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
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.
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:
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