此程序是申永胜主编的《机械原理教程》(清华大学出版社),第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
Pic1.PSet (yy, xx), vbGreen1 b/ w- G0 t) T( `$ v1 Wi
Fai = Fai + 0.001
1 h7 l4 f! H J; q$ V1 Y" q$ G End If, T6 P, {+ {+ i1 G6 w& y9 p+ I
End If
( ?2 q) T T) }/ w Wend% W7 a7 ^5 H3 Q3 _, w
Pic1.Circle (0, 0), Rb
- Y$ o% G* @) p: j( M) TEnd Sub
2 S1 y- n& |5 R6 ]Private Sub Command2_Click() "计算最小基圆半径* X/ J- K& }l( B8 b- _* I
Aifa1 = Val(Text2) / 180 * 3.1415926
7 z* F2 gH; s; P$ Q4 a