凸轮机构的运动仿真

此程序是申永胜主编的《机械原理教程》（清华大学出版社），第129页的例题3.3 大家有什么意见，请发表。谢谢大家的关注！ 我把主要的代码写在下面，完整的程序请看附件。 Option Explicit Public Fai, Fai1, Fai2, W, Rb, h As Double Public s, v, a, x, y As Double Public ds, dx, dy As Double "一阶导数 Public dds, ddx, ddy As Double "二阶导数 Public P As Double "曲率半径 Public α As Double "压力角 Const Pi As Double = 3.1415926 Public Aifa1 As Double "推程许用压力角 Public Aifa2 As Double "回程许用压力角 Public Pa, Rr As Double "实际轮廓线的许用曲率半径，滚子半径 Public xx, yy As Double Private Sub Command1_Click() "画轮廓线 Pic1.Cls Pic1.AutoRedraw = True Pic1.Scale (-100, 100)-(100, -100) Pic1.Line (100, 0)-(-100, 0), vbRed Pic1.Line (0, -100)-(0, 100), vbRed Fai = 0 Rr = Val(Text4) While Fai <= 2 * Pi If Fai <= Pi Then s = h * (Fai / Fai1 - Sin(2 * Pi * Fai / Fai1) / Pi / 2) x = (Rb + s) * Sin(Fai) y = (Rb + s) * Cos(Fai) Pic1.PSet (y, x) ds = h / Fai1 * (1 - Cos(2 * Pi * Fai / Fai1)) dx = (Rb + s) * Cos(Fai) + ds * Sin(Fai) dy = -(Rb + s) * Sin(Fai) + ds * Cos(Fai) xx = x + Rr * dy / Sqr(dx ^ 2 + dy ^ 2) yy = y - Rr * dx / Sqr(dx ^ 2 + dy ^ 2) Pic1.PSet (yy, xx), vbGreen Fai = Fai + 0.001 Else If Fai <= 1.5 * Pi Then s = 50 x = (Rb + s) * Sin(Fai) y = (Rb + s) * Cos(Fai) Pic1.PSet (y, x) ds = 0 dx = (Rb + s) * Cos(Fai) + ds * Sin(Fai) dy = -(Rb + s) * Sin(Fai) + ds * Cos(Fai) xx = x + Rr * dy / Sqr(dx ^ 2 + dy ^ 2) yy = y - Rr * dx / Sqr(dx ^ 2 + dy ^ 2) Pic1.PSet (yy, xx), vbGreen Fai = Fai + 0.001 Else s = h * (1 - (Fai - 1.5 * Pi) / Fai2 + Sin(2 * Pi * (Fai - 1.5 * Pi) / Fai2) / Pi / 2) x = (Rb + s) * Sin(Fai) y = (Rb + s) * Cos(Fai) Pic1.PSet (y, x) ds = h * (-1 + Cos(2 * Pi * (Fai - 1.5 * Pi) / Fai2)) / Fai2 dx = (Rb + s) * Cos(Fai) + ds * Sin(Fai) dy = -(Rb + s) * Sin(Fai) + ds * Cos(Fai) xx = x + Rr * dy / Sqr(dx ^ 2 + dy ^ 2) yy = y - Rr * dx / Sqr(dx ^ 2 + dy ^ 2) Pic1.PSet (yy, xx), vbGreen Fai = Fai + 0.001 End If End If Wend Pic1.Circle (0, 0), Rb End Sub Private Sub Command2_Click() "计算最小基圆半径 Aifa1 = Val(Text2) / 180 * 3.1415926 Aifa2 = Val(Text3) / 180 * 3.1415926 Rr = Val(Text4) Pa = Val(Text5) Call MinRb Text1 = Rb MsgBox finished Command1.Enabled = True End Sub Private Sub Form_Load() Command1.Enabled = False h = 50 Fai1 = Pi Fai2 = Pi / 2 W = 10 End Sub Public Sub MinRb() "求最小基圆半径 Fai = 0 Rb = 1 Be: While 1 Select Case Int(Fai / Pi * 2) Case 0, 1 s = h * (Fai / Fai1 - Sin(2 * Pi * Fai / Fai1) / Pi / 2) ds = h / Fai1 * (1 - Cos(2 * Pi * Fai / Fai1)) dds = 2 * Pi * h * Sin(2 * Pi * Fai / Fai1) / Fai1 / Fai1 dx = (Rb + s) * Cos(Fai) + ds * Sin(Fai) dy = -(Rb + s) * Sin(Fai) + ds * Cos(Fai) ddx = dy + dds * Sin(Fai) + ds * Cos(Fai) ddy = -dx + dds * Cos(Fai) - ds * Sin(Fai) α = Atn(Abs(ds) / (s + Rb)) P = (dx ^ 2 + dy ^ 2) ^ 1.5 / (-dx * ddy + ddx * dy) If α <= Aifa1 Then If P < 0 Then Fai = Fai + 0.01 GoTo Be Else If P >= Pa + Rr Then Fai = Fai + 0.01 GoTo Be Else Rb = Rb + 0.02 Fai = 0 End If End If Else: Rb = Rb + 0.02: Fai = 0 End If Case 2 s = h ds = 0 dds = 0 dx = (Rb + s) * Cos(Fai) + ds * Sin(Fai) dy = -(Rb + s) * Sin(Fai) + ds * Cos(Fai) ddx = dy + dds * Sin(Fai) + ds * Cos(Fai) ddy = -dx + dds * Cos(Fai) - ds * Sin(Fai) α = Atn(Abs(ds) / (s + Rb)) P = (dx ^ 2 + dy ^ 2) ^ 1.5 / (-dx * ddy + ddx * dy) If α <= Aifa1 Then If P < 0 Then Fai = Fai + 0.01 GoTo Be Else If P >= Pa + Rr Then Fai = Fai + 0.01 GoTo Be Else Rb = Rb + 0.02 Fai = 0 End If End If Else: Rb = Rb + 0.01: Fai = 0 End If Case 3, 4 s = h * (1 - (Fai - 1.5 * Pi) / Fai2 + Sin(2 * Pi * (Fai - 1.5 * Pi) / Fai2) / Pi / 2) ds = h * (-1 + Cos(2 * Pi * (Fai - 1.5 * Pi) / Fai2)) / Fai2 dds = -h * 2 * Pi * Sin(2 * Pi * (Fai - 1.5 * Pi) / Fai2) / Fai2 / Fai2 dx = (Rb + s) * Cos(Fai) + ds * Sin(Fai) dy = -(Rb + s) * Sin(Fai) + ds * Cos(Fai) ddx = dy + dds * Sin(Fai) + ds * Cos(Fai) ddy = -dx + dds * Cos(Fai) - ds * Sin(Fai) α = Atn(Abs(ds) / (s + Rb)) P = (dx ^ 2 + dy ^ 2) ^ 1.5 / (-dx * ddy + ddx * dy) If α <= Aifa2 Then If P < 0 Then If Fai > 2 * Pi Then Exit Sub Else Fai = Fai + 0.01 GoTo Be End If Else If P >= Pa + Rr Then If Fai > 2 * Pi Then Exit Sub Else Fai = Fai + 0.01 GoTo Be End If Else: Rb = Rb + 0.02: Fai = 0 End If End If Else: Rb = Rb + 0.02: Fai = 0 End If End Select Wend End Sub Public Sub Exit1() If Fai > 2 * Pi Then Exit Sub Else Fai = Fai + 0.01 End If End Sub Private Sub Introduce_Click() "显示程序说明对话框 frmAbout1.Show 1 End Sub