' 程序名称：圆柱直齿轮设计
' Author:ncf
' Date:2016-10-29
' Email:1476879092@qq.com
' log:
' 2016-10-29:Complete
Public Check3_flag As Boolean

Private Sub Check1_Click()
    If Check2.Value = 1 Then Check2.Value = 0
End Sub

Private Sub Check2_Click()
    If Check1.Value = 1 Then Check1.Value = 0
End Sub

Private Sub Check3_Click()
    If Check3.Value = 1 Then
        Check3_flag = True    '开式为True
        Check3.Caption = "开式传动"
    Else
        Check3_flag = False    '开式为True
        Check3.Caption = "闭式传动"
    End If
End Sub

Private Sub Command1_Click()
'数据的输入
    p_0 = Val(Text1.Text)    '输入的功率
    N_1 = Val(Text5.Text)    '小齿轮转速
    S_a = Val(Text21.Text)    '工作机载荷性质代码
    P_w = Val(Text9.Text)    '原动机代码
    W_N = Val(Text10.Text)    '工作两班
    H_0 = Val(Text22.Text)    '一班的时间
    D_A = Val(Text11.Text)    '工作时间
    j = Val(Text23.Text)    'j 为每转一圈齿轮啮合次数
    MA1 = Val(Text6.Text)    '小齿轮材料热处理代码
    MA2 = Val(Text18.Text)    '大齿轮材料热处理代码
    HB_x = Val(Text7.Text)    '小齿轮硬度
    HB_d = Val(Text19.Text)    '大齿轮硬度
    K_ht = Val(Text8.Text)     '接触试选载荷系数
    K_ft = Val(Text20.Text)     '弯曲试选载荷系数
    FD = Val(Text15.Text)     '齿宽系数
    RF = 1    '设计准则的选用标志,注：这里我们直接同时采用两个标准设计，不采用一个设计，一个校核
    pai = 3.1415926536    '圆周率pi
    ha = Val(Text2.Text)     '齿顶高系数
    alpha = Val(Text14.Text) / 180 * pai   '分度圆压力角
    JZ = Val(Text3.Text)     '精度等级
    CJ = Val(Text13.Text)     '支撑结构选择

'确定计算方式
    flag_js = 0
    If Check1.Value = 1 Then flag_js = 1
    If Check2.Value = 1 Then flag_js = 2
    If flag_js <> 0 Then
        '检测空缺数据
        flag_space = 1
        If flag_js = 1 Then    '齿数已知
            ZV1 = Val(Text4.Text)    '小齿轮齿数
            ZV2 = Val(Text16.Text)    '大齿轮齿数
            Text12.Text = 0
            If ZV1 = 0 Or ZV2 = 0 Or p_0 = 0 Or N_1 = 0 Or S_a = 0 Or P_w = 0 Or W_N = 0 Or H_0 = 0 Or D_A = 0 Or j = 0 Or MA1 = 0 Or MA2 = 0 Or HB_x = 0 Or HB_d = 0 Or K_ht = 0 Or K_ft = 0 Or FD = 0 Or ha = 0 Or alpha = 0 Or JZ = 0 Or CJ = 0 Then
                MsgBox ("请确保设计参数填写正确")
            Else
                u = ZV2 / ZV1
                Text12.Text = u
                Text17.Text = Val(Text5.Text) / u    '大齿轮转速
                flag_space = 0    '数据无空缺
            End If
        Else    '传动比已知
            If Check3_flag = False Then
                If HB_x > 350 Then ZV1 = 18 Else ZV1 = 24    '闭式硬齿面默认18齿，闭式软齿24齿
            Else
                ZV1 = 18    '开式18齿
            End If
            u = Val(Text12.Text)    '齿数比
            If u = 0 Or p_0 = 0 Or N_1 = 0 Or S_a = 0 Or P_w = 0 Or W_N = 0 Or H_0 = 0 Or D_A = 0 Or j = 0 Or MA1 = 0 Or MA2 = 0 Or HB_x = 0 Or HB_d = 0 Or K_ht = 0 Or K_ft = 0 Or FD = 0 Or ha = 0 Or alpha = 0 Or JZ = 0 Or CJ = 0 Then
                MsgBox ("请确保设计参数填写正确")
            Else
                ZV2 = Round(ZV1 * u)    '大齿轮齿数
                Text4.Text = ZV1  '小齿轮齿数
                Text16.Text = ZV2  '小齿轮齿数
                Text17.Text = Val(Text5.Text) / u    '大齿轮转速
                flag_space = 0    '数据无空缺
            End If
        End If
        '计算
        If flag_space = 0 Then    '检测空缺数据
            '通用数据的计算

            '转矩的计算
            T_1 = 9.55 * (10 ^ 6) * p_0 / N_1

            '许用应力的计算
            '应力循环次数的计算
            N1 = 60 * j * N_1 * (W_N * H_0 * D_A)
            N2 = N1 / u
            '寿命系数
            Call Zichengxu1(MA1,N1,KB1)
            Call Zichengxu1(MA2,N2,KB2)
            Call Zichengxu3(MA1,KH1)
            Call Zichengxu3(MA2,KH2)
            '许用应力
            Call Zichengxu2(MA1,HB_x,KB1,CB1)
            Call Zichengxu2(MA2,HB_d,KB2,CB2)
            Call Zichengxu4(MA1,KH1,CH1)
            Call Zichengxu4(MA2,KH2,CH2)

            '计算重合度
            Call arccoa(ZV1 * Cos(alpha) / (ZV1 + 2 * ha),alpha1)
            Call arccoa(ZV2 * Cos(alpha) / (ZV2 + 2 * ha),alpha2)
            e_alpha = (ZV1 * (Tan(alpha1) - Tan(alpha)) + ZV2 * (Tan(alpha2) - Tan(alpha))) / 2 / pai
            '使用系数KA的查询
            Call KA_find(S_a,P_w,KA)

            '按接触强度设计

            '计算重合度系数
            Z_e = Sqr((4 - e_alpha) / 3)
            '计算ze zh
            U1 = 0.3    '泊松比
            U2 = 0.3
            E1 = 20.6 * 10000    '锻钢的弹性模量
            E2 = 20.6 * 10000
            Call Zichengxu7(alpha,U1,U2,E1,E2,ZH,ZE)
            '带入计算时数据的选用
            If CH1 > CH2 Then CH = CH2 Else CH = CH1    '选接触疲劳许用应力小的
            '试算分度圆直径
            d_1t = ((2 * K_ht * T_1 / FD) * ((u + 1) / u) * ((ZH * ZE * Z_e) / CH) ^ 2) ^ (1 / 3)
            '计算系数KV
            Call KV_js(ZV1,d_1t,N_1,JZ,KV)
            '调整小齿轮分度圆直径
            Call Zichengxu8(HB_x,CJ,FD,KHB,KFB)
            KH = KV * KA * KHB    '忽略齿间载荷分配系数K_alpha
            D1 = d_1t * ((KH / K_ht) ^ (1 / 3))
            m_H = D1 / ZV1

            '按齿根弯曲强度设计

            '计算重合度系数
            Y_e = 0.25 + 0.75 / e_alpha
            '修正系数的计算
            Call Zichengxu5(ZV1,YFA1)
            Call Zichengxu5(ZV2,YFA2)
            Call Zichengxu6(ZV1,YSA1)
            Call Zichengxu6(ZV2,YSA2)
            YK1 = YFA1 * YSA1 / CB1
            YK2 = YFA2 * YSA2 / CB2
            '带入计算时数据的选用
            If YK2 > YK1 Then YK = YK2 Else YK = YK1    '在弯曲疲劳强度的设计中也是选小的
            '试算模数
            m_1t = (2 * K_ft * T_1 * Y_e / (FD * ZV1 ^ 2) * YK) ^ (1 / 3)
            d_1t = m_1t * ZV1
            '计算系数KV
            Call KV_js(ZV1,d_1t_F,KV)
            '调整小齿轮模数
            Call Zichengxu8(HB_x,KFB)
            KF = KV * KA * KFB
            m_F = m_1t * ((KF / K_ft) ^ (1 / 3))
            '两种设计结果的处理

            '已知传动比
            If flag_js = 2 Then    '传动比已知
                If m_H > m_F Then
                    Call m_find(m_F,m_b)    '标准化模数
                    Z_1 = Round(D1 / m_b)    '修改小齿轮齿数
                    Z_2 = Round(Z_1 * u)    '大齿轮齿数
                    d_1 = Z_1 * m_b    '小齿轮直径
                    d_2 = Z_2 * m_b    '大齿轮直径
                    A = (d_1 + d_2) / 2    '中心距
                    B_d = FD * d_1    '大齿轮齿宽
                    B_x = B_d + 7.5    '小齿轮齿宽
                Else
                    Z_1 = ZV1 '不修改齿数
                    Z_2 = ZV2
                    Call m_find(m_F,m_b)    '标准化模数
                    d_1 = Z_1 * m_b    '小齿轮直径
                    d_2 = Z_2 * m_b    '大齿轮直径
                    A = (d_1 + d_2) / 2    '中心距
                    B_d = FD * d_1    '大齿轮齿宽
                    B_x = B_d + 7.5    '小齿轮齿宽
                End If
            ElseIf flag_js = 1 Then    '齿数已知
                If m_H > m_F Then
                    m_ = m_H
                Else
                    m_ = m_F
                End If
                Z_1 = ZV1 '不修改齿数
                Z_2 = ZV2
                Call m_find(m_,m_b)    '标准化模数
                d_1 = Z_1 * m_b    '小齿轮直径
                d_2 = Z_2 * m_b    '大齿轮直径
                A = (d_1 + d_2) / 2    '中心距
                B_d = FD * d_1    '大齿轮齿宽
                B_x = B_d + 7.5    '小齿轮齿宽
            End If
            '显示输出
            Text24.Text = m_b
            Text25.Text = A
            Text26.Text = Z_1
            Text27.Text = Z_2
            Text28.Text = d_1
            Text29.Text = d_2
            Text30.Text = B_x
            Text31.Text = B_d
        End If
    Else
        MsgBox ("请选择：计算方式")
    End If
End Sub

'自定义子程序
'KA的获取
Sub KA_find(S_a,KA)
    S_a = S_a - 1
    P_w = P_w - 1
    Dim KA_array1()
    KA_array1 = Array(1#,1.1,1.25,1.5)
    Dim KA_array2
    KA_array2 = Array(1.25,1.35,1.5,1.75)
    Dim KA_array3
    KA_array3 = Array(1.5,1.6,1.75,2)
    Dim KA_array4
    KA_array4 = Array(1.75,1.85,2,2.25)
    If S_a = 0 Then
        KA = KA_array1(P_w)
    ElseIf S_a = 1 Then
        KA = KA_array2(P_w)
    ElseIf S_a = 2 Then
        KA = KA_array3(P_w)
    ElseIf S_a = 3 Then
        KA = KA_array4(P_w)
    Else
    End If
End Sub
'm的查询
Sub m_find(m,m_b)
    Dim m_bz
    m_bz = Array(1,2.5,3,4,5,6,8,10)
    num_m = UBound(m_bz) - LBound(m_bz)
    For i = 0 To num_m
        If m < m_bz(i) Then
            m_b = m_bz(i)
            Exit For
        End If
    Next i
End Sub
'反余弦函数
Sub arccoa(X1,alpha1)
    alpha1 = Atn(-X1 / Sqr(-X1 * X1 + 1)) + 2 * Atn(1)
End Sub
'计算KV
Sub KV_js(Z1,D1,N0,KV)
    V = Z1 * 3.14159 * D1 * NO / 6000000!
    KV = (0.0104 + 0.003 * (JZ - 6)) * JZ * V + 1
End Sub


'老师提供的子程序
Sub Zichengxu1(MA,N,KB)
    If MA > 27 Then GoTo 1035
    If N <= 10000! Then GoTo 1025
    If N > 10000! And N < 3000000! Then GoTo 1030
    If N > 3000000! Then KB = 1!: GoTo 1125
1025:
    KB = 2.5: GoTo 1125
1030:
    KB = (3! * 10 ^ 6 / N) ^ (0.115): GoTo 1125
1035:
    If MA > 36 Or MA < 27 Then GoTo 1065
    If N <= 1000! Then GoTo 1055
    If N > 1000! And N < 3000000! Then GoTo 1060
    If N > 3000000! Then KB = 1!: GoTo 1125
1055:
    KB = 2.5: GoTo 1125
1060:
    KB = (3! * 10 ^ 6 / N) ^ (0.115): GoTo 1125
1065:
    If MA > 46 Or MA < 36 Then GoTo 1095
    If N <= 1000! Then GoTo 1085
    If N > 1000! And N < 3000000! Then GoTo 1090
    If N > 3000000! Then KB = 1!: GoTo 1125
1085:
    KB = 1.6: GoTo 1125
1090:
    KB = (3! * 10 ^ 6 / N) ^ (0.05900001): GoTo 1125
1095:
    If MA < 46 Then GoTo 1125
    If N < 1000! Then GoTo 1115
    If N > 1000! And N < 3000000! Then GoTo 1120
    If N > 3000000! Then KB = 1!: GoTo 1125
1115:
    KB = 1.1: GoTo 1125
1120:
    KB = (3! * 10 ^ 6 / N) ^ (0.012)
1125:
End Sub
Sub Zichengxu2(MA,HB,KB,CB)
    If MA > 15 Then GoTo 1160
    On MA - 10 GoTo 1140,1145,1150,1155
1140:
    CB = 0.66 * (HB - 140) + 120: GoTo 1230
1145:
    CB = 0.6850001 * (HB - 140) + 350: GoTo 1230
1150:
    CB = 0.2 * (HB - 110) + 300: GoTo 1230
1155:
    CB = 0.6 * (HB - 110) + 340: GoTo 1230
1160:
    If MA > 27 Then GoTo 1190
    On MA - 22 GoTo 1170,1175,1180,1185
1170:
    CB = 0.37 * (HB - 115) + 340: GoTo 1230
1175:
    CB = 0.75 * (HB - 115) + 380: GoTo 1230
1180:
    CB = 0.8 * (HB - 190) + 520: GoTo 1230
1185:
    CB = 0.47 * (HB - 190) + 460: GoTo 1230
1190:
    If MA > 36 Then GoTo 1210
    On MA - 33 GoTo 1200,1205
1200:
    CB = 10 * (HB - 48) + 640: GoTo 1230
1205:
    CB = 3 * (HB - 56) + 840: GoTo 1230
1210:
    If MA = 44 Or MA = 45 Then GoTo 1220
    If MA = 54 Or MA = 55 Then CB = 2! * (HB - 54) + 640: GoTo 1230
1220:
    CB = 2! * (HB - 54) + 740
1230:
    CB = KB * CB / 1.375
End Sub
Sub Zichengxu3(MA,KH)
    If MA > 37 And FI = 1 Then GoTo 1545
    If N <= 600000! Then GoTo 1530
    If N > 600000! And N < 10000000# Then GoTo 1535
    If N > 10000000# And N < 1000000000# Then GoTo 1540
    If N > 1000000000# Then KH = 1!: GoTo 1640
1530:
    KH = 1.6: GoTo 1640
1535:
    KH = (3! * 10 ^ 8 / N) ^ (0.0756): GoTo 1640
1540:
    KH = (10 ^ 9 / N) ^ (0.05700001): GoTo 1640
1545:
    If MA > 37 Or MA < 22 Then GoTo 1575
    If N < 100000! Then GoTo 1565
    If N > 100000! And N < 50000000# Then GoTo 1570
    If N > 50000000# Then KH = 1!: GoTo 1640
1565:
    KH = 1.6: GoTo 1640
1570:
    KH = (5 * 10 ^ 7 / N) ^ (0.0756): GoTo 1640
1575:
    If MA > 47 Or MA < 42 Then GoTo 1605
    If N <= 100000! Then GoTo 1595
    If N > 100000! And N < 2000000! Then GoTo 1600
    If N > 2000000! Then KH = 1!: GoTo 1640
1595:
    KH = 1.3: GoTo 1640
1600:
    KH = (2 * 10 ^ 6 / N) ^ (0.0875): GoTo 1640
1605:
    If MA < 52 Then GoTo 1640
    If N <= 100000! Then GoTo 1625
    If N > 100000! And N < 2000000! Then GoTo 1630
    If N >= 2000000! Then KH = 1!: GoTo 1640
1625:
    KH = 1.1: GoTo 1640
1630:
    KH = (2 * 10 ^ 6 / N) ^ (0.0318)
1640:
End Sub
Sub Zichengxu4(MA,KH,CH)
    If MA > 15 Then GoTo 1680
    On MA - 10 GoTo 1663,1665,1670,1675
1663:
    CH = 1.154 * (HB - 140) + 300: GoTo 1800
1665:
    CH = 1.406 * (HB - 140) + 400: GoTo 1800
1670:
    CH = 190 + HB: GoTo 1800
1675:
    CH = 260 + HB: GoTo 1800
1680:
    If MA > 27 Then GoTo 1710
1685 On MA - 22 GoTo 1690,1695,1700,1705
1690:
    CH = 290 + HB: GoTo 1800
1695:
    CH = 350 + HB: GoTo 1800
1700:
    CH = 1.465 * (HB - 190) + 620: GoTo 1800
1705:
    CH = 1.4 * (HB - 190) + 550: GoTo 1800
1710:
    If MA > 36 Then GoTo 1745
    If MA = 34 Then GoTo 1730
    If MA = 35 Then GoTo 1735
    If MA = 35 And HB > 58 Then GoTo 1740
1730:
    CH = 25 * (HB - 48) + 1120: GoTo 1800
1735:
    CH = 60 * (HB - 56) + 1350: GoTo 1800
1740:
    CH = 1470: GoTo 1800
1745:
    If MA > 50 Then GoTo 1775
    If MA = 44 Or MA = 45 Then CH = 11.1 * (HB - 36) + 900
    If MA = 44 And HB > 45 Then GoTo 1765
    If MA = 45 And HB > 45 Then GoTo 1770
    GoTo 1800
1765:
    CH = 1000: GoTo 1800
1770:
    CH = 1000: GoTo 1800
1775:
    If MA = 54 Or MA = 55 Then CH = 18 * (HB - 54) + 1225
1780 If MA = 54 And HB > 59 Then GoTo 1790
1786 If MA = 55 And HB > 59 Then GoTo 1795
1787 GoTo 1800
1790:
    CH = 1315: GoTo 1800
1795:
    CH = 1315
1800:
    CH = KH * CH
End Sub
Sub Zichengxu5(ZV,YFA)
    YFA = 2.984508 - 0.014134 * ZV + 0.000051 * ZV ^ 2
End Sub
Sub Zichengxu6(ZV,YSA)
    YSA = 1.472047 + 0.00497 * ZV - 0.000016 * ZV ^ 2
End Sub
Sub Zichengxu7(AL,ZE)
    ZH = Sqr(2 / (Sin(AL) * Cos(AL)))
    ZE = 0.564 * Sqr(1 / ((1 - U1 ^ 2) / E1 + (1 - U2 ^ 2) / E2))
End Sub
'修改程序8
Sub Zichengxu8(H1,H2,KFB)
    If H1 > 350 And H2 > 350 Then GoTo 2450
    On CJ GoTo 2415,2420,2425,2430,2435,2440,2445
2415:
    KHB = 0.24 * FD + 0.4456 * FD ^ 2 + 1.0054: GoTo 2490
2420:
    KHB = 0.29184 * FD + 0.06218 * FD ^ 2 + 0.99569: GoTo 2490
2425:
    KHB = 0.10482 * FD + 0.04448 * FD ^ 2 + 1.0036: GoTo 2490
2430:
    KHB = 0.0395 * FD + 0.04968 * FD ^ 2 + 1.013: GoTo 2490
2435:
    KHB = 0.02576 * FD + 0.04125 * FD ^ 2 + 1.011: GoTo 2490
2440:
    KHB = -0.007 * FD + 0.03977 * FD ^ 2 + 1.157: GoTo 2490
2445:
    KHB = -0.0177 * FD + 0.0337 * FD ^ 3 + 1.00977: GoTo 2490
2450 On CJ GoTo 2455,2460,2465,2470,2475,2480,2485
2455:
    KHB = 1.05 * FD + 1: GoTo 2490
2460:
    KHB = 0.41026 * FD + 0.51246 * FD ^ 2 + 1.0033: GoTo 2490
2465:
    KHB = 0.29503 * FD + 0.07772 * FD ^ 2 + 1.00587: GoTo 2490
2470:
    KHB = 0.18042 * FD + 0.08549999 * FD ^ 2 + 1.00498: GoTo 2490
2475:
    KHB = 0.0907 * FD + 0.09494 * FD ^ 2 + 1.00352: GoTo 2490
2480:
    KHB = 0.01265 * FD + 0.08847999 * FD ^ 2 + 1.0095: GoTo 2490
2485:
    KHB = -0.009289999 * FD + 0.06270001 * FD ^ 2 + 1.00862
2490:
    KFB = 1.5 * KHB - 0.5
End Sub

http://pan.baidu.com/s/1i4B1Hxb