参数输入.frm

一个设计齿轮变位系数的程序

'检查m是否正确
  If (m < 0.1) Or (m > 50) Then
      Beep
       A3 = MsgBox("模数输入错误，请查看说明!", vbOKOnly + vbExclamation + vbDefaultButton1, "警告")
      If A3 = 1 Then
          Text3.SetFocus
          SendKeys "{Home}+{End}"
      End If
      Exit Sub
  End If
'检查β是否正确
  If (Option2.Value = True) Then
  If (Val(Text4.Text) < 8) Or (Val(Text4.Text) > 20) Then
      Beep
      A4 = MsgBox("螺旋角输入错误，请查看说明!", vbOKOnly + vbExclamation + vbDefaultButton1, "警告")
      If A4 = 1 Then
           Text4.SetFocus
           SendKeys "{Home}+{End}"
      End If
      Exit Sub
    End If
    End If
 '输入无错则处理数据
   UR5 = MsgBox("正在处理数据,请稍候.......", vbOKCancel + vbInformation + vbDefaultButton1, "程序信息")
   Select Case UR5
       Case 1
       Case 2
              Beep
              End
   End Select
   '计算小齿轮齿数Z1
   z1 = Int(2 * ap * Cos(b) / (m * (1 + i)))
   '计算大齿轮齿数Z2
   z2 = Int(z1 * i)
   '计算标准中心距ab
   ab = (z1 + z2) * m / (2 * Cos(b))
   '计算端面压力角rt
   rt = Atn(Tan(r) / Cos(b))
   '计算实际压力角rr
   rr = Atn(Sqr(1 - (ab * Cos(rt) / ap) ^ 2) / (ab * Cos(rt) / ap))
   '计算变位系数和x0
   x0 = ((inv(rr) - inv(rt)) * (z1 + z2) / (2 * Tan(rt))) / Cos(b)
   '计算齿高降低量yn
   yn = x0 - (ap - ab) / (m / Cos(b))
   '计算小齿轮最小变位系数x1min
   x1min = h - 0.5 * z1 * (Sin(r)) ^ 2
   '计算大齿轮最小变位系数x2min
   x2min = h - 0.5 * z2 * (Sin(r)) ^ 2
   '计算小齿轮最大变位系数x1max
   x1max = x0 - x2min
   '计算大齿轮最大变位系数x2max
   x2max = x0 - x1min
   
'计算小齿轮分度圆半径r1
r1 = m * z1 / (2 * Cos(b))
'计算大齿轮分度圆半径r2
r2 = m * z2 / (2 * Cos(b))
'计算小齿轮基圆半径rb1
rb1 = z1 * m / (2 * Cos(b)) * Cos(rt)
'计算大齿轮基圆半径rb2
rb2 = z2 * m / (2 * Cos(b)) * Cos(rt)
    '显示结果

结果窗口.T1 = z1
结果窗口.T2 = z2
结果窗口.T3 = Int(ab)
结果窗口.T4 = rr * 180 / pi
结果窗口.T5 = r1
结果窗口.T6 = r2
结果窗口.T7 = rb1
结果窗口.T8 = rb2
结果窗口.T9 = x0
结果窗口.T10 = x1min
结果窗口.T11 = x1max
结果窗口.T12 = x2min
结果窗口.T13 = x2max

参数输入.Hide



'以下用逐点比较法，调用判断函数求最优解
    '先求得一个最小的可行点xpoint1
   bc = (x1max - x1min) / 100000
   xpoint1 = x1min
   If PanDuan(xpoint1) = False Then
   Do While xpoint1 < x1max
           xp1 = xpoint1 + bc
           xpoint1 = xp1
       If PanDuan(xpoint1) = True Then
       Exit Do
       End If
   Loop
   End If
   G = Goal(xpoint1)
   dot = xpoint1
   x1 = dot
   x2 = x0 - x1
   n1max = n1m(x1)
   n2max = n2m(x2)
   '判断整个范围内是否有多于一个的可行点
   If (PanDuan(xpoint1) = False) Or (xpoint1 > x1max - 2 * bc) Then
       Beep
       UR6 = MsgBox("数据不能处理或程序非法执行，将返回参数窗口，" & _
       "请重输参数或结束程序！", vbOKOnly + vbExclamation + vbDefaultButton1, "警告")
       参数输入.Show
       Exit Sub
    '如果有多于一个的可行点,则进行逐点比较目标函数值
   Else: xpoint2 = xpoint1
         Do While xpoint2 <= x1max - bc
             On Error GoTo errorhandle
             xp2 = xpoint2 + bc
             xpoint2 = xp2
             If PanDuan(xpoint2) = True Then
                 If Goal(xpoint2) < G Then
                     G = Goal(xpoint2)
                     dot = xpoint2
                 End If
             End If
         Loop
   End If
   x1 = dot
   x2 = x0 - x1
   n1max = n1m(x1)
   n2max = n2m(x1)
   Load 结果窗口
   结果窗口.Show
   Exit Sub
'错误处理语句
errorhandle: Beep
             UR7 = MsgBox("由于数据不能处理或程序执行时出错，优化结果可能不够精确" & _
             "！", vbOKOnly + vbInformation + vbDefaultButton1, "抱歉")
             x1 = dot
             x2 = x0 - x1
             n1max = n1m(x1)
             n2max = n2m(x2)
             Load 结果窗口
             结果窗口.Show


End Sub

Private Sub Command3_Click()
    Dim UR As Integer
         Beep
    UR = MsgBox("您要离开本程序吗？", vbYesNo + vbQuestion + vbDefaultButton2, "您想.....")
      Select Case UR
           Case 7
                Beep
                Text1.SetFocus
                SendKeys "{Home}+{End}"
            Case 6
                Me.Hide
                End
              Unload 参数输入
              Unload 登录窗口
              Unload 显示窗口
              Unload 欢迎窗口
              Unload 结果窗口
    End Select
End Sub

'说明文字
Private Sub Command4_Click()
     str_i = "传动比i按机械工作要求及结构尺寸而定。减速时，i≤5～7，开式传动可取更大些。增速时，i≤2.5～3。对于平稳载荷齿轮传动，z1和z2取整数比；" & _
             "对不稳定变载荷齿轮传动，z1和z2应互为质数。单级平行轴齿轮传动一般传动比在1～8，最大可以到 10。"
     Label9.Caption = str_i

End Sub

Private Sub Command5_Click()
    str_ap = "单对平行轴圆柱齿轮传动对传动中心距限制很弱，小模数的齿轮中心距可以小一些"
    Label9.Caption = str_ap

End Sub

Private Sub Command6_Click()
    str_m1 = "齿轮模数一般应优先选用第一系列，其次是第二系列，括号内的尽量不要选用" & _
    "（特殊情况下也可以用）。"
    str_m2 = "第一系列：0.1  0.12  0.15  0.2  0.25  0.3  0.4  0.5  0.6  0.8  1  1.25" & _
             "  1.5  2  2.5  3  4  5  6  8  10  12  16  20  25  32  40  50；"
    str_m3 = "    第二系列：0.35  0.7  0.9  1.75  2.25  2.75   （3.25）3.5 （3.75）4.5" & _
             "  5.5   （6.5）7  9（11）14  18  22  28（30）36  45。"
    Label9.Caption = str_m1 & str_m2 & str_m3
   
End Sub

Private Sub Command7_Click()
    str_b = "一般情况下，直齿轮就可以实现齿轮传动的优点，加工也容易。但斜齿轮有它自己" & _
            "的优点，螺旋角选用一般在8～20°。"
    Label9.Caption = str_b

End Sub
Private Sub Command8_Click()
    str_r = "分度圆上的压力角为标准值，α=20°。在某些场合，α也有采用α=14.5°、15°、22.5°及25°等的情况。"
    Label9.Caption = str_r
End Sub

Private Sub Command9_Click()
    str_qita = "现在用短齿制的情况较少。" & _
               "大小齿轮齿顶厚度许用值一般取为[sa]=（0.25～0.4）m，本设计取[sa]=0.25。许用重合度一般取为[ε]=1.2，本设计取[ε]=1.2。"
    Label9.Caption = str_qita
End Sub
Private Sub Form_Load()
 
    SendKeys "{Home}+{End}"
    Text1.Text = " 请参看说明"
    Text2.Text = " 请参看说明"
    Text3.Text = " 请参看说明"
    Text4.Text = " 请参看说明"
    Text4.Visible = False
    Label6.Visible = False
    Option1.Value = True
    Option2.Value = False
    Option3.Value = True
    Option4.Value = False
    Option5.Value = False
    Option6.Value = False
    Option7.Value = False
    Option8.Value = True
    Option9.Value = False
End Sub



Private Sub Option1_Click()
    b = 0
    Text4.Visible = False
    Label6.Visible = False
 End Sub
    Private Sub Command2_Click()
    Text1.SetFocus
    SendKeys "{Home}+{End}"
    Text1.Text = " 请参看说明"
    Text2.Text = " 请参看说明"
    Text3.Text = " 请参看说明"
    Text4.Text = " 请参看说明"
    Text4.Visible = False
    Label6.Visible = False
    Option1.Value = True
    Option2.Value = False
    Option3.Value = True
    Option4.Value = False
    Option5.Value = False
    Option6.Value = False
    Option7.Value = False
    Option8.Value = True
    Option9.Value = False
    End Sub


Private Sub Option2_Click()
    Text4.Visible = True
    Label6.Visible = True
    Text4.SetFocus
    SendKeys "{Home}+{End}"
 End Sub

Private Sub Option3_Click()
   r = 20 / 180 * pi
End Sub

Private Sub Option4_Click()
   r = 14.5 / 180 * pi
End Sub

Private Sub Option5_Click()
   r = 25 / 180 * pi
End Sub

Private Sub Option6_Click()
  r = 15 / 180 * pi
End Sub

Private Sub Option7_Click()
  r = 22.5 / 180 * pi
End Sub

Private Sub Option8_Click()
    h = 1
    c = 0.25
End Sub

Private Sub Option9_Click()
    h = 0.8
    c = 0.3
End Sub

Private Sub Text1_Change()
    i = Val(Text1.Text)
End Sub

Private Sub Text1_GotFocus()
          Text1.SetFocus
          SendKeys "{Home}+{End}"
End Sub

Private Sub Text2_Change()
    ap = Val(Text2.Text)
    
End Sub

Private Sub Text2_GotFocus()
          Text2.SetFocus
          SendKeys "{Home}+{End}"
End Sub

Private Sub Text3_Change()
    m = Val(Text3.Text)
End Sub

Private Sub Text3_GotFocus()
          Text3.SetFocus
          SendKeys "{Home}+{End}"
End Sub

Private Sub Text4_Change()
    b = Val(Text4.Text) / 180 * pi
End Sub