Const pi As Double = 3.1415926
Const rr As Double = pi / 180
Const rr2 As Double = 180 / pi
Public w As Double
Public r0 As Double
Public h As Double
Public tj As Double
Const qj = 0
Public tcj As Double
Public hcj As Double
Public yxj As Double
Public sg As Integer
Public q As Integer
Public xqb As Double
Public ii As Integer, jj As Integer, nn As Integer
Public zxj As Double
Public temp1 As Double
Public temp2 As Double
Public temp3 As Double
Public temp4 As Double
Public temp5 As Double
Public temp6 As Double
Public tempa As Double
Public l As Double
Dim s(360) As Double
Dim v(360) As Double
Dim a(360) As Double
Dim x(360) As Double, y(360) As Double
Public fa As Double
Public om As Double
Public xi As Double
Public bt As Double
Dim x1(360) As Double
Dim y1(360) As Double
Public p As Integer
Public e As Double
Private Sub Command1_Click()
om = 1
Timer1.Enabled = False
Label12.Caption = "该图缩放比例1:2"
w = 1: r0 = Val(Text2.Text): e = Val(Text1.Text) '初始参数赋值
h = Val(Text3.Text):
tcj = Val(Text4.Text) * rr: hcj = Val(Text6.Text) * rr
yxj = Val(Text5.Text) * rr
If 360 * rr < tcj + hcj + yxj Or tcj + hcj + yxj <= 0 Then
Beep
MsgBox "请输入正确的角度!", vbQuestion + vbDefaultButton1, "提示!" '运行提示
Exit Sub
End If
If h = 0 Then
Beep
MsgBox "从动件最大位移不能为0!", vbQuestion + vbDefaultButton1, "提示!"
Exit Sub
End If
If e >= r0 Then
Beep
MsgBox "请输入正确的基圆半径或偏距!", vbQuestion + vbDefaultButton1, "提示!"
Exit Sub
End If
If tcj < 0 Or hcj < 0 Or yxj < 0 Then
Beep
MsgBox "请输入正确的角度!", vbQuestion + vbDefaultButton1, "提示!"
Exit Sub
End If
If Combo2.Text = "x轴正侧" Then
p = 1
ElseIf Combo2.Text = "x轴负侧" Then
p = -1
Else: p = 0
End If
If r0 + h > 170 Or r0 < 5 Then
Beep
MsgBox "该尺寸凸轮无法正常显示!", vbQuestion + vbDefaultButton1, "注意"
Exit Sub
End If
If Text1.Text = "" Or Text4.Text = "" Or Text5.Text = "" Or Text6.Text = "" Then
Beep
MsgBox "请输入全部数据!", vbQuestion + vbDefaultButton1, "提示!"
Exit Sub
End If
If Text1.Text = "" Or Text2.Text = "" Or Text3.Text = "" Then
Beep
MsgBox "请输入全部数据!", vbQuestion + vbDefaultButton1, "提示!"
Exit Sub
End If
If Combo1.Text = "" Then
Beep
MsgBox "请选择转向!", vbQuestion + vbDefaultButton1, "提示!"
Exit Sub
End If
If Combo2.Text = "" Then
Beep
MsgBox "请选择从动件偏移方向!", vbQuestion + vbDefaultButton1, "提示!"
Exit Sub
End If
If Combo3.Text = "" Or Combo4.Text = "" Then
Beep
MsgBox "请选择推程或回程运动方式!", vbQuestion + vbDefaultButton1, "提示!"
Exit Sub
End If
Picture2.Cls '清屏
Picture4.Cls
Command2.Enabled = True
Command3.Enabled = False
Combo1.Enabled = False
For ii = 0 To 360
tj = ii * rr
If tj >= 0 And tj <= qj Then
s(ii) = 0: v(ii) = 0: a(ii) = 0
GoTo b
ElseIf tj > qj And tj <= qj + tcj Then
sg = 1
xcombo3 Combo3
GoTo b
ElseIf tj > qj + tcj And tj <= (qj + tcj + yxj) Then
s(ii) = h: v(ii) = 0: a(ii) = 0
GoTo b
ElseIf tj > (qj + tcj + yxj) And tj <= (qj + tcj + yxj + hcj) Then
sg = 0
xcombo4 Combo4
GoTo b
Else: s(ii) = 0: v(ii) = 0: a(ii) = 0
b: Call zdgz(ii, tj, w, r0, e, q, p, s(), v(), a(), x(), y())
End If
Next ii
Call jsmaxz(temp1, temp2, temp3, temp4)
draw2z Picture2
l = (r0 ^ 2 - e ^ 2) ^ 0.5
draw4z Picture4
Command6.Enabled = True
End Sub
Private Sub Command4_Click()
Dim j As Integer
j = MsgBox("确定返回到题目?", vbOKCancel + vbExclamation + vbDefaultButton1, "注意")
If j = 1 Then
Load Form2
Form2.Show
Unload Me
Else
Exit Sub
End If
Load Form2
Form2.Show
Unload Me
End Sub
Private Sub Form_Load() '设置初值
Combo1.AddItem "逆时针"
Combo1.AddItem "顺时针"
Combo2.AddItem "x轴正侧"
Combo2.AddItem "x轴负侧"
Combo3.AddItem "等速运动"
Combo3.AddItem "等加速 等减速"
Combo3.AddItem "摆线运动"
Combo3.AddItem "简谐运动"
Combo4.AddItem "等速运动"
Combo4.AddItem "等加速 等减速"
Combo4.AddItem "摆线运动"
Combo4.AddItem "简谐运动"
End Sub
Private Sub Command5_Click() '退出
Dim j As Integer
j = MsgBox("谢谢使用,再见!", vbOKCancel + vbExclamation + vbDefaultButton1, "提示!")
If j = 1 Then
End
Else
Exit Sub
End If
End Sub
Private Sub HScroll1_Change()
speed = 300 - HScroll1.Value
Timer1.Interval = speed
End Sub
Public Sub xcombo3(Combo3 As ComboBox) '选择运动方式
If Combo3.Text = "等速运动" Then
Call dsyd(ii, h, tj, qj, w, tcj, hcj, yxj, sg, s(), v(), a())
ElseIf Combo3.Text = "等加速 等减速" Then
Call djsdjs(ii, h, tj, qj, w, tcj, hcj, yxj, sg, s(), v(), a())
ElseIf Combo3.Text = "摆线运动" Then
Call bxyd(ii, h, tj, qj, w, tcj, hcj, yxj, sg, s(), v(), a())
ElseIf Combo3.Text = "简谐运动" Then
Call jxyd(ii, h, tj, qj, w, tcj, hcj, yxj, sg, s(), v(), a())
End If
End Sub
Public Sub xcombo4(Combo4 As ComboBox)
If Combo4.Text = "等速运动" Then
Call dsyd(ii, h, tj, qj, w, tcj, hcj, yxj, sg, s(), v(), a())
ElseIf Combo4.Text = "等加速 等减速" Then
Call djsdjs(ii, h, tj, qj, w, tcj, hcj, yxj, sg, s(), v(), a())
ElseIf Combo4.Text = "摆线运动" Then
Call bxyd(ii, h, tj, qj, w, tcj, hcj, yxj, sg, s(), v(), a())
ElseIf Combo4.Text = "简谐运动" Then
Call jxyd(ii, h, tj, qj, w, tcj, hcj, yxj, sg, s(), v(), a())
End If
End Sub
Public Sub jsmaxz(temp1 As Double, temp2 As Double, temp3 As Double, temp4 As Double) '暂时最大值
temp1 = Abs(s(0)): temp2 = Abs(v(0)): temp3 = Abs(a(0)): temp4 = Sqr(x(0) ^ 2 + y(0) ^ 2)
For ii = 1 To 360
If Abs(s(ii)) > temp1 Then
temp1 = Abs(s(ii))
Else: temp1 = temp1
End If
If Abs(v(ii)) > temp2 Then
temp2 = Abs(v(ii))
Else: temp2 = temp2
End If
If Abs(a(ii)) > temp3 Then
temp3 = Abs(a(ii))
Else: temp3 = temp3
End If
If Sqr(x(ii) ^ 2 + y(ii) ^ 2) > temp4 Then
temp4 = Sqr(x(ii) ^ 2 + y(ii) ^ 2)
Else: temp4 = temp4
End If
Next ii
End Sub
Public Sub draw2z(Picture2 As PictureBox) '从动件运动规律图
Picture2.ScaleLeft = -15: Picture2.ScaleTop = 30
Picture2.ScaleWidth = 92: Picture2.ScaleHeight = -60
Picture2.Line (Picture2.ScaleLeft, 0)-(66, 0)
Picture2.Line (0, 27)-(0, -27)
Picture2.Line (64, 1)-(66, 0)
Picture2.Line (64, -1)-(66, 0)
Picture2.Line (10, 0)-(10, 1)
Picture2.Line (20, 0)-(20, 1)
Picture2.Line (30, 0)-(30, 1)
Picture2.Line (40, 0)-(40, 1)
Picture2.Line (50, 0)-(50, 1)
Picture2.Line (60, 0)-(60, 1)
Picture2.Line (0, 20)-(1, 20)
Picture2.Line (0, 15)-(1, 15)
Picture2.Line (0, 10)-(1, 10)
Picture2.Line (0, 5)-(1, 5)
Picture2.Line (0, -5)-(1, -5)
Picture2.Line (0, -10)-(1, -10)
Picture2.Line (0, -15)-(1, -15)
Picture2.Line (0, -20)-(1, -20)
Picture2.Line (0, 27)-(1, 25)
Picture2.Line (0, 27)-(-1, 25)
Picture2.Line (8, -25)-(12, -25), vbGreen
Picture2.CurrentX = 13
Picture2.CurrentY = -23
Picture2.Print "位移"
Picture2.Line (24, -25)-(28, -25), vbRed
Picture2.CurrentX = 29
Picture2.CurrentY = -23
Picture2.Print "速度"
Picture2.Line (39, -25)-(43, -25), vbBlue
Picture2.CurrentX = 44
Picture2.CurrentY = -23
Picture2.Print "加速度"
Picture2.CurrentX = 52
Picture2.CurrentY = 5
Picture2.Print "ψ(°)"
For jj = 0 To 5
Picture2.CurrentX = jj * 10 + 6
Picture2.CurrentY = -4
Picture2.Print 60 * (jj + 1)
Next jj
Picture2.CurrentX = -8
Picture2.CurrentY = -4
Picture2.Print 0
For ii = 1 To 360
Picture2.Line ((ii - 1) / 6, s(ii - 1) * 15 / temp1)-(ii / 6, s(ii) * 15 / temp1), vbGreen
Picture2.Line ((ii - 1) / 6, v(ii - 1) * 15 / temp1)-(ii / 6, v(ii) * 15 / temp1), vbRed
If temp3 < 0 Or temp3 > 0 Then
Picture2.Line ((ii - 1) / 6, a(ii - 1) * 15 / temp1)-(ii / 6, a(ii) * 15 / temp1), vbBlue
Else: Picture2.Line ((ii - 1) / 6, a(ii - 1))-(ii / 6, a(ii)), vbBlue
End If
Next ii
End Sub
Public Sub dsyd(ByVal ii As Integer, ByVal h As Double, ByVal tj As Double, ByVal qj As Double, ByVal w As Double, ByVal tcj As Double, ByVal hcj As Double, ByVal yxj As Double, ByVal sg As Double, s() As Double, v() As Double, a() As Double)
If sg = 1 Then
s(ii) = h * (tj - qj) / tcj: v(ii) = h * w / tcj: a(