I am working on a programming project whose purpose is to manually select several dimensions, which will then be calculated according to a formula predefined in the program. I have two problems that I can't solve.
When selecting the dimensions in the 3D model, I want to retrieve the maximum and minimum values of the dimensions. Currently, the maximum price is well recovered, but the price that is supposed to be at the minimum displays the nominal price. M
Tolerances are in " symmetrical " format and the only solution I have found to make this work is to put my tolerances in " bilateral " format. However, I have too many odds and I can't afford to change them all. It would therefore have to work for tolerances in " symmetrical " format as well. I'm attaching my program to this message (I've changed a few settings for privacy reasons, which shouldn't bother you answering my question). 2. How do I recover the face value of a quote?
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
I got the wrong person, sorry! I confused it with another user of the forum. You're by no means the person I was thinking of ^^. Have a good day to you. PS: To people of your type, embittered, I'm not asking for help, thank you.
The PS may be too much, isn't it? @Maclane may have misinterpreted a message, but bitter for a person who spends his time helping others (Top contributor N°1 at the moment), I doubt it very much:
Maybe it's exaggerated, but I found his message very negative knowing that I had no bad intentions behind it... But no problem, we are here to solve problems, to help each other and not to debate about it
