机械原理实验VB程序

Private Sub Command1_Click()

Dim L1, L2, L3, L4 As Double

Dim s1_Degree, s2_Degree, s3_Degree, s1, s2, s3 As Double Dim w1, w2, w3 As Double

Dim a1, a2, a3 As Double

Dim A, B, C As Double

Dim i As Integer

pi = 3.1415926

L1 = Val(Text1.Text)

L2 = Val(Text2.Text)

L3 = Val(Text3.Text)

L4 = Val(Text4.Text)

w1 = Val(Text5.Text)

Text6.Text = Text6.Text & " s1" & "

" & "s3" & Chr(13) & Chr(10)

Text7.Text = Text7.Text & " w1" & "

" & "w3" & Chr(13) & Chr(10)

Text8.Text = Text8.Text & " a1" & "

" & "a3" & Chr(13) & Chr(10)

i = 0

For s1_Degree = 0 To 360 Step 30

i = i + 1 " & "s2" & " " & "w2" & " " & "a2" & "

s1 = s1_Degree * pi / 180

A = L4 - L1 * Cos(s1)

B = -L1 * Sin(s1)

C = (A ^ 2 + B ^ 2 + L3 ^ 2 - L2 ^ 2) / (2 * L3)

s3 = 2 * Atn((B + Sqr(A * A + B * B - C * C)) / (A - C))

s2 = Atn((B + L3 * Sin(s3)) / (A + L3 * Cos(s3)))

s2_Degree = s2 * 180 / pi

s3_Degree = s3 * 180 / pi

w3 = w1 * ((L1 * Sin(s1 - s2)) / (L3 * Sin(s3 - s2)))

w2 = -w1 * ((L1 * Sin(s1 - s3)) / (L2 * Sin(s2 - s3)))

a1 = 0

a3 = (L2 * w2 * w2 + L1 * w1 * w1 * Cos(s1 - s2) - L3 * w3 * w3 * Cos(s3 - s2)) / (L3 * Sin(s3 - s2))

a2 = (L3 * w3 * w3 - L1 * w1 * w1 * Cos(s1 - s3) - L2 * w2 * w2 * Cos(s2 - s3)) / (L2 * Sin(s2 - s3))

Text6.Text = Text6.Text & Format(s1_Degree, "0.000") & " " & Format(s2_Degree, "0.000") & " " & Format(s3_Degree, "0.000") & Chr(13) & Chr(10)

Text7.Text = Text7.Text & Format(w1, "0.000") & " " & Format(w2, "0.000") & " " & Format(w3, "0.000") & Chr(13) & Chr(10)

Text8.Text = Text8.Text & Format(a1, "0.000") & " " &

Format(a2, "0.000") & " " & Format(a3, "0.000") & Chr(13) & Chr(10)

Next s1_Degree

End Sub

Private Sub Command2_Click()

Unload Form1

End Sub

Private Sub Command1_Click()

Dim p1, p2, p3 As Double

Dim e, rb, rr, h As Double

Dim s, s0 As Double

Dim x, y, x1, y1, dxdp, dydp As Double

pi = 3.1415926

e = Val(Text1.Text)

rb = Val(Text2.Text)

rr = Val(Text3.Text)

h = Val(Text4.Text)

p1 = Val(Text5.Text)

p2 = Val(Text6.Text)

p3 = Val(Text7.Text)

Text8.Text = Text8.Text & "D" & " " & "x" & " " & "y" & " " & "x1" & " " & "y1" & Chr(13) & Chr(10) s0 = Sqr(rb * rb - e * e)

Dim Theat_Deg As Integer

For Theat_Deg = 0 To 360 Step 30

If (Theat_Deg >= 0 And Theat_Deg <= p1) Then

s = h * Theat_Deg / p1

Theat_Rad = Theat_Deg * pi / 180

x = (s0 + s) * Sin(Theat_Rad) + e * Cos(Theat_Rad) y = (s0 + s) * Cos(Theat_Rad) - e * Sin(Theat_Rad) dxdp = (s0 + s) * Cos(Theat_Rad) - e * Sin(Theat_Rad) dydp = -(s0 + s) * Sin(Theat_Rad) - e * Cos(Theat_Rad) x1 = x + rr * (dydp / Sqr(dxdp * dxdp + dydp * dydp))

y1 = y - rr * (dxdp / Sqr(dxdp * dxdp + dydp * dydp)) ElseIf (Theat_Deg > p1 And Theat_Deg <= p2) Then s = h

Theat_Rad = Theat_Deg * pi / 180

x = (s0 + s) * Sin(Theat_Rad) + e * Cos(Theat_Rad) y = (s0 + s) * Cos(Theat_Rad) - e * Sin(Theat_Rad)

dxdp = (s0 + s) * Cos(Theat_Rad) - e * Sin(Theat_Rad) dydp = -(s0 + s) * Sin(Theat_Rad) - e * Cos(Theat_Rad) x1 = x + rr * (dydp / Sqr(dxdp * dxdp + dydp * dydp)) y1 = y - rr * (dxdp / Sqr(dxdp * dxdp + dydp * dydp))

ElseIf (Theat_Deg > p2 And Theat_Deg <= p3) Then s = h - h * (Theat_Deg - p2) / (p3 - p2)

Theat_Rad = Theat_Deg * pi / 180

x = (s0 + s) * Sin(Theat_Rad) + e * Cos(Theat_Rad) y = (s0 + s) * Cos(Theat_Rad) - e * Sin(Theat_Rad)

dxdp = (s0 + s) * Cos(Theat_Rad) - e * Sin(Theat_Rad) dydp = -(s0 + s) * Sin(Theat_Rad) - e * Cos(Theat_Rad) x1 = x + rr * (dydp / Sqr(dxdp * dxdp + dydp * dydp)) y1 = y - rr * (dxdp / Sqr(dxdp * dxdp + dydp * dydp))

ElseIf (Theat_Deg > p3 And Theat_Deg <= 360) Then s = 0

Theat_Rad = Theat_Deg * pi / 180

x = (s0 + s) * Sin(Theat_Rad) + e * Cos(Theat_Rad) y = (s0 + s) * Cos(Theat_Rad) - e * Sin(Theat_Rad)

dxdp = (s0 + s) * Cos(Theat_Rad) - e * Sin(Theat_Rad) dydp = -(s0 + s) * Sin(Theat_Rad) - e * Cos(Theat_Rad) x1 = x + rr * (dydp / Sqr(dxdp * dxdp + dydp * dydp)) y1 = y - rr * (dxdp / Sqr(dxdp * dxdp + dydp * dydp))

End If

Text8.Text = Text8.Text & Format(Theat_Deg, "0.0") & " " & Format(x, "0.000") & " " & Format(y, "0.000") & " " & Format(x1, "0.000") & " " & Format(y1, "0.000") & " " & Chr(13) & Chr(10) Next Theat_Deg

End Sub

Private Sub Command2_Click()

End

End Sub

Private Sub Command3_Click() Text1.Text = ""

Text2.Text = ""

Text3.Text = ""

Text4.Text = ""

Text5.Text = ""

Text6.Text = ""

Text7.Text = ""

Text8.Text = ""

End Sub

Option Explicit

Dim n As Single, z1 As Single, z2 As Single, m As Single, A_Real

As Single, A_Theory As Single

Dim p As Single, r1 As Single, r2 As Single

Dim s As Single, e As Single, alpha_1 As Single

Dim s1 As Single

Dim rf1 As Single, rf2 As Single, ra1 As Single, ra2 As Single, rb1 As Single, rb2 As Single

Dim ha As Single, c As Single

Dim pi As Single

Dim ep As Single

Dim x1min, x1 As Single, x2min, x2 As Single, x0 As Single Dim y, delta_y As Single

Dim ha1, ha2, hf1, hf2 As Single

Dim alpha, alpha_20 As Single

Dim inv_alpha, inv_alpha_1 As Single

Dim sa1 As Single

Private Sub Command1_Click()

Dim TempX, TempY As Single

z1 = Text2.Text

z2 = Text3.Text

A_Real = Text4.Text

m = Text5.Text

alpha_20 = 20

pi = 3.1415926

ha = 1

c = 0.25

A_Theory = m * (z1 + z2) / 2

If A_Real = A_Theory Then

Call j1(r1, r2, rf1, rf2, ra1, ra2)

Picture1.Print "这对齿轮是标准安装。"

Picture1.Print "标准压力角是:" + Str(alpha_20) + "°" Picture1.Print "模数是:" + Str(m)

Picture1.Print "齿轮1的齿数是:" + Str(z1)

Picture1.Print "齿轮1的分度圆半径是:" + Str(r1) + "mm"

Picture1.Print "齿轮1的齿顶圆半径是:" + Str(ra1) + "mm"

Picture1.Print "齿轮1的齿根圆半径是:" + Str(rf1) + "mm"

Picture1.Print "齿轮2的齿数是:" + Str(z2)

Picture1.Print "齿轮2的分度圆半径是:" + Str(r2) + "mm"

Picture1.Print "齿轮2的齿顶圆半径是:" + Str(ra2) + "mm"

Picture1.Print "齿轮2的齿根圆半径是:" + Str(rf2) +

"mm"

Else

alpha = alpha_20 * pi / 180

r1 = m * z1 / 2

r2 = m * z2 / 2

rb1 = r1 * Cos(alpha)

rb2 = r2 * Cos(alpha)

TempX = A_Theory * Cos(alpha) / A_Real TempY = Sqr(1 - TempX ^ 2)

alpha_1 = Atn(TempY / TempX)

inv_alpha = Tan(alpha) - alpha

inv_alpha_1 = Tan(alpha_1) - alpha_1

x0 = (inv_alpha_1 - inv_alpha) * (z1 + Tan(alpha))

x1min = (17 - z1) / 17

x2min = (17 - z2) / 17

If x0 = 0 Then

Picture1.Print "这对齿轮是 零 传动!" ElseIf x0 > 0 Then

Picture1.Print "这对齿轮是 正 传动!" ElseIf x0 < 0 Then

Picture1.Print "这对齿轮是 负 传动!" z2) / (2 *

End If

Call j2(rf1, rf2, ra1, ra2, s, alpha_1, sa1, x1, x2, x0)

Picture1.Print "啮合角:" + Str(alpha_1 * 180 / pi) + "度" Picture1.Print "总变位系数x0=" + Str(x0)

Picture1.Print "变位系数x1=" + Str(x1)

Picture1.Print "齿轮1最小变位系数x1min=" + Str(x1min)

Picture1.Print "齿轮1的分度圆半径是:" + Str(r1) + "mm"

Picture1.Print "齿轮1的齿顶圆半径是:" + Str(ra1) + "mm"

Picture1.Print "齿轮1的齿根圆半径是:" + Str(rf1) + "mm"

Picture1.Print "齿轮1的齿顶齿厚是:" + Str(sa1) + "mm" Picture1.Print "变位系数x2=" + Str(x2)

Picture1.Print "齿轮2最小变位系数x2min=" + Str(x2min)

Picture1.Print "齿轮2的分度圆半径是:" + Str(r2) + "mm"

Picture1.Print "齿轮2的齿顶圆半径是:" + Str(ra2) + "mm"

Picture1.Print "齿轮2的齿根圆半径是:" + Str(rf2) +

"mm"

Picture1.Print "齿轮的重合度为:" + Str(ep)

End If

End Sub

Private Sub Command2_Click()

Text1.Text = ""

Text2.Text = ""

Text3.Text = ""

Text4.Text = ""

Text5.Text = ""

Picture1.Cls

End Sub

Private Sub Command3_Click()

Unload Form1

End Sub

Private Sub j1(r1 As Single, r2 As Single, rf1 As Single, rf2 As Single, ra1 As Single, ra2 As Single)

r1 = m * z1 / 2

r2 = m * z2 / 2

ra1 = (z1 + 2 * ha) * m / 2

ra2 = (z1 + 2 * ha) * m / 2

rf1 = (z1 - 2 * ha - 2 * c) * m / 2

rf2 = (z2 - 2 * ha - 2 * c) * m / 2

End Sub

Private Sub j2(rf1 As Single, rf2 As Single, ra1 As Single, ra2 As Single, s As Single, alpha_1 As Single, sa1 As Single, x1 As Single, x2 As Single, x0 As Single) '子程序2

Dim step_x1, Temp_s1, Temp_c1, Temp_s2, Temp_c2 As Single

Dim alpha_a1, inv_alpha_a1, alpha_a2, i As Single

step_x1 = (x0 - x2min - x1min) / 10

For i = 0 To 10 Step 1

x1 = x1min + i * step_x1

x2 = x0 - x1

y = (A_Real - A_Theory) / m

delta_y = x1 + x2 - y

ha1 = (ha + x1 - delta_y) * m

hf1 = (ha + c - x1) * m

ra1 = r1 + ha1

rf1 = r1 - hf1

ha2 = (ha + x2 - delta_y) * m

hf2 = (ha + c - x2) * m

ra2 = r2 + ha2

rf2 = r2 - hf2

s1 = (pi / 2 + 2 * x1 * Tan(alpha)) * m

Temp_s1 = rb1 / ra1

Temp_c1 = Sqr(1 - Temp_s1 ^ 2)

alpha_a1 = Atn(Temp_c1 / Temp_s1)

inv_alpha_a1 = Tan(alpha_a1) - alpha_a1

Dim alpha11 As Single

alpha11 = alpha_a1 * 180 / pi

sa1 = s1 * ra1 / r1 - 2 * ra1 * (inv_alpha_a1 - inv_alpha) Temp_s2 = rb2 / ra2

Temp_c2 = Sqr(1 - Temp_s2 ^ 2)

alpha_a2 = Atn(Temp_c2 / Temp_s2)

Dim alpha22 As Single

alpha22 = alpha_a2 * 180 / pi

ep = (z1 * (Tan(alpha_a1) - Tan(alpha_1)) + z2 * (Tan(alpha_a2) - Tan(alpha_1))) / (2 * pi)

If ep > 1.1 And ep < 1.981 And sa1 > 0.4 * m Then Exit For

Next i

End Sub

相关推荐