大齿轮模块程序清单

1、大齿轮模块程序清单Option Explicit'定义自定义变量类型Type gear_data p As Single '输入功率 n1 As Single 'I轴转数 uu As Single '传动比 st As Single '齿轮布置 gg As Integer '齿轮精度 fd As Single '齿宽系数 np As Single '效率 kt As Single '初选载荷系数 ka As Single '工况系数 ly As Single '寿命 wn As Single '每天

2、班制 ds As Boolean '齿轮表面允许点蚀否？ gm(4) As Integer 'gm(1):高速级小齿轮材料 'gm(2):高速级大齿轮材料 'gm(3):低速级小齿轮材料 'gm(4):低速级大齿轮材料 mh(4) As Integer 'mh(1):高速级小齿轮热处理 'mh(2):高速级大齿轮热处理 'mh(3):低速级小齿轮热处理 'mh(4):低速级大齿轮热处理 hb(4) As Integer 'hb(1):高速级小齿轮硬度 布氏硬度 'hb(2):高速级大齿轮硬度 'hb

3、(3):低速级小齿轮硬度 'hb(4):低速级大齿轮硬度 rc(4) As Integer 'rc(1):高速级小齿轮硬度 洛氏硬度 'rc(2):高速级大齿轮硬度 'rc(3):低速级小齿轮硬度 'rc(4):低速级大齿轮硬度 End Type '优化的数据和通过优化计算出的基本数据Type yh_data mn1 As Single '优化数据之1 x1 mn2 As Single '优化数据之3 x3 z1 As Single '优化数据之2 x2 z2 As Single z3 As Single '优化数

4、据之4 x4 z4 As Single u1 As Single '优化数据之5 x5 u2 As Single bt As Single '优化数据之6 x6 n2 As SingleEnd TypeType yfys yf As Single '齿形系数 ys As Single '应力集中系数End TypeType erkr er As Single '端面重合度 kr As Single '齿间载荷分配系数End Type'全局变量Public my_gear_data As gear_data '存放初始参数Publi

5、c daa(4) As Single, dff(4) As Single 'scr文件引用 齿顶圆 齿根圆直径Public b1 As Single, b2 As Single, b3 As Single, b4 As Single '最终的齿宽Public d1 As Single, d2 As Single, d3 As Single, d4 As Single '最终的分度圆直径Public m1 As Single, m2 As Single '圆整后的模数Public xp(21, 10) As Single '复合型法的顶点数组Public

6、a(10) As Single, b(10) As Single '边界条件数组Public m(21) As Single, h(21) As Integer '选取最坏点数组Public c(13) As Single '约束条件数组Public f(21) As Single 'f(x) 目标函数Public rec As Integer '记录变量Public n As Integer, mm1 As Integer '初始参数Public e As Single, g As Single '初始参数'复合形法子程序Pub

7、lic Sub fhx_optimum() Dim j As Integer, k As Integer '循环变量 Dim s As Integer '记数变量 Dim q As Boolean '判定tj_pd子程序的返回值的临时变量 Dim mm As Integer, hh As Integer '最坏点 Dim bb As Boolean '收敛准则判定变量 Dim aa As Single '反射系数 Dim temp As Single '临时交换变量 Dim w As Single '临时变量 Dim u As S

8、ingle '临时变量 Dim zxd1 As Boolean '循环变量 Dim ii As Integer Dim v1 As Single, v2 As Single, v3 As Single '求f(x)的临时变量 Dim pi As Single '- '读入初始数据 '添加代码 n = 6: e = 0.1: g = 0.5: mm1 = 7: pi = 3'- '边界条件 '添加代码 a(1) = 2: b(1) = 5 a(2) = 17: b(2) = 30 a(3) = 2.

9、5: b(3) = 4 a(4) = 17: b(4) = 30 a(5) = 2.8: b(5) = 4.5 a(6) = 8 * pi / 180: b(6) = 15 * pi / 180 '-Do Do For ii = 1 To 2 * n Do Call qd_cs_kxd(ii) '产生初始点 q = tj_pd(ii) '判定 Loop While q = False Next ii s = 2 * n Call qd_xx(s) '求形心 s = 0 q = tj_pd(s) Loop While q = False rec = 1 '

10、-ppqq: zxd1 = True Do While zxd1 = True Call qd_fx '求f(x) '- bb = True For k = 1 To 2 * n '收敛准则 If Abs(f(0) - f(k) > 0.01 Then bb = False End If Next k '- If bb = True Then '# Call qd_result '出口，打印优化结果 Exit Sub Else '# For j = 1 To 2 * n '确定最坏点，最好点，次坏点 m(j) = f(j)

11、Next j For j = 1 To 2 * n h(j) = j Next j For j = 1 To 2 * n - 1 For k = j + 1 To 2 * n If m(j) > m(k) Then Exit For Else temp = m(j): m(j) = m(k): m(k) = temp temp = h(j): h(j) = h(k): h(k) = temp End If Next k Next j mm = 1: hh = h(mm) '找出最坏点位置 For j = 1 To n '去除最坏点xp(h,j)求形心 xp(0, j) =

12、 (xp(0, j) * 2 * n - xp(hh, j) / (2 * n - 1) Next j ii = 0 '? '- q = tj_pd(ii) If q = False Then w = h(2 * n) For j = 1 To n a(j) = xp(w, j): b(j) = xp(0, j) Next j zxd1 = False '上下界重新调整，重新确定初始可行点 Else '- aa = 1.3 Do Call qd_fs1(aa, hh) ii = 2 * n + 1 q = tj_pd(ii) If q = True Then f

13、(2 * n + 1) = qd_every_fx(2 * n + 1) If f(2 * n + 1) < f(hh) Then Exit Do End If If aa <= g Then If mm > 2 Then For j = 1 To 2 * n Do Do Call qd_fs(j) '缩边生成新复合形 q = tj_pd(j) '判定 Loop While q = False s = 2 * n Call qd_xx(s) q = tj_pd(s) Loop While q = False Next j GoTo ppqq Else mm =

14、 mm + 1 hh = h(mm) End If Else aa = aa / 2 End If Else aa = aa / 2 If aa <= g Then If mm > 2 Then For j = 1 To 2 * n Do Do Call qd_fs(j) '缩边生成新复合形 q = tj_pd(j) '判定 Loop While q = False s = 2 * n Call qd_xx(s) q = tj_pd(s) Loop While q = False Next j GoTo ppqq Else mm = mm + 1 hh = h(mm

15、) End If End If End If Loop '- For j = 1 To n xp(hh, j) = xp(2 * n + 1, j) Next j rec = rec + 1 For j = 1 To n u = 0 For k = 1 To 2 * n u = u + xp(k, j) Next k xp(0, j) = u / (2 * n) Next j '- End If End If LoopLoopEnd Sub'条件判断Public Function tj_pd(iii As Integer) As BooleanDim j As Inte

16、ger, k As Integer '循环变量For j = 1 To n '边界条件判断 If xp(iii, j) < a(j) Then tj_pd = False Exit Function End If If xp(iii, j) > b(j) Then tj_pd = False Exit Function End IfNext jCall cm_jc_plqd_sj(iii) '接触疲劳强度、弯曲疲劳强度计算For j = 1 To mm1 '约束条件判断 If c(j) < 0 Then tj_pd = False Exit F

17、unction End IfNext jtj_pd = TrueDebug.Print "f(" 0; ")=" Int(f(0) * 1000 + 0.5) / 1000, "rec=" rec '显示每回结果End Function'产生初始点Public Sub qd_cs_kxd(ii As Integer)'添加代码Dim j As SingleFor j = 1 To nxp(ii, j) = a(j) + Rnd(1) * (b(j) - a(j)Next jEnd Sub'产生其余点Pu

18、blic Sub qd_qt_kxd()Dim j As IntegerDim k As IntegerFor j = 2 To 2 * n For k = 1 To n xp(j, k) = a(k) + Rnd(1) * (b(k) - a(k) Next kNext jEnd Sub'求形心Public Sub qd_xx(ss As Integer)Dim j As IntegerDim k As IntegerDim t As Single For j = 1 To n t = 0 For k = 1 To ss t = t + xp(k, j) Next k xp(0, j

19、) = t / ss Next jEnd Sub'向形心移动Public Sub qd_fs(ss As Integer)Dim j As Integer'添加代码For j = 1 To n xp(ss + 1, j) = xp(0, j) + (xp(ss + 1, j) - xp(0, j) / 2Next jEnd Sub'求f(x),2*n个Public Sub qd_fx()Dim k As IntegerFor k = 0 To 2 * n f(k) = qd_every_fx(k)Next kEnd Sub'求每个f(x)Public Funct

20、ion qd_every_fx(i As Integer) As Single'添加代码Dim y1 As Single, y2 As Single, y3 As Singley1 = xp(i, 1) * xp(i, 2) * (1 + xp(i, 5)y2 = xp(i, 3) * xp(i, 4) * (1 + my_gear_data.uu / xp(i, 5)y3 = 2 * Cos(xp(i, 6)qd_every_fx = (y1 + y2) / y3End Function'再次反射Public Sub qd_fs1(aaa As Single, hhh As

21、Integer)Dim j As IntegerFor j = 1 To n xp(2 * n + 1, j) = xp(0, j) + aaa * (xp(0, j) - xp(hhh, j) '反射Next jEnd Sub'输出优化结果Public Sub qd_result()Dim j As Integer, k As IntegerForm2.Visible = TrueForm2.Print "no.of iteration=" recFor j = 0 To 2 * n For k = 1 To n Form2.Print Int(1000

22、* xp(j, k) + 0.5) / 1000; Tab(k * 10); " " Next k Form2.Print f(j) Next jEnd Sub'斜齿圆柱齿轮（软、硬齿面）传动计算程序Public Sub cm_jc_plqd_sj(iiii As Integer)Dim aa1 As Single, aa2 As Single, aa3 As Single, aa4 As Single, aa5 As Single, aa6 As Single '中间变量Dim bb1 As Single, bb2 As Single '中间变量D

23、im c7 As Integer '中间变量Dim temp_yh_data As yh_dataDim t1 As Single, t3 As Single '扭矩Dim sn(4) As Single '应力循环次数Dim ze1 As Single, ze2 As Single '弹性影响系数Dim er1 As Single, er2 As Single '端面重合度Dim kr1 As Single, kr2 As Single '齿间载荷分配系数Dim bb As Single '基圆螺旋角Dim r As Single &#

24、39;齿轮分度圆压力角的角度数Dim rt As Single '端面压力角Dim zh As Single '节点区域系数Dim kh(4) As Single '齿轮接触疲劳寿命系数Dim kf(4) As Single '齿轮弯曲疲劳寿命系数Dim ho(4) As Single '齿轮材料接触疲劳极限Dim fo(4) As Single '齿轮材料弯曲疲劳极限Dim hp(4) As Single '齿轮材料接触疲劳许用应力Dim fp(4) As Single '齿轮材料弯曲疲劳许用应力Dim zv(4) As Sin

25、gle '当量齿数Dim yf(4) As Single '齿形系数Dim ys(4) As Single '应力集中系数Dim ss As Single '安全系数Dim eb1 As Single, eb2 As Single '轴向重合度Dim tb1 As Single, tb2 As Single 'temp_yh_data.bt 的角度数Dim be1 As Single, be2 As SingleDim yb1 As Single, yb2 As Single '螺旋角影响系数'按齿面接触疲劳强度设计相关参数tem

26、p_yh_data.z1 = xp(iiii, 2) '每次的优化结果temp_yh_data.z3 = xp(iiii, 4)temp_yh_data.u1 = xp(iiii, 5)temp_yh_data.bt = xp(iiii, 6)temp_yh_data.u2 = my_gear_data.uu / temp_yh_data.u1temp_yh_data.z2 = Int(temp_yh_data.z1 * temp_yh_data.u1)temp_yh_data.z4 = Int(temp_yh_data.z3 * temp_yh_data.u2)temp_yh_dat

27、a.n2 = my_gear_data.n1 / temp_yh_data.u1t1 = 9550000! * my_gear_data.p / my_gear_data.n1 '扭矩t3 = 9550000! * my_gear_data.p * my_gear_data.np / temp_yh_data.n2sn(1) = my_gear_data.n1 * my_gear_data.ly * my_gear_data.wn * 144000! '工作周数sn(2) = sn(1) / temp_yh_data.u1sn(3) = 60 * temp_yh_data.n2

28、 * 1 * (my_gear_data.wn * 8 * 300 * my_gear_data.ly)sn(4) = sn(3) / temp_yh_data.u2ze1 = jh_ze(my_gear_data.gm(1), my_gear_data.gm(2)ze2 = jh_ze(my_gear_data.gm(3), my_gear_data.gm(4)er1 = jh_er_kr(temp_yh_data.z1, temp_yh_data.z2, temp_yh_data.bt).er '重合度kr1 = jh_er_kr(temp_yh_data.z1, temp_yh_

29、data.z2, temp_yh_data.bt).kr '载荷分配系数er2 = jh_er_kr(temp_yh_data.z3, temp_yh_data.z4, temp_yh_data.bt).erkr2 = jh_er_kr(temp_yh_data.z3, temp_yh_data.z4, temp_yh_data.bt).krr = 20 * 0.017453 '压力角rt = Atn(Tan(r) / Cos(temp_yh_data.bt) '端面压力角bb = Atn(Tan(temp_yh_data.bt) * Cos(rt) '基圆螺旋

30、角zh = Sqr(2 * Cos(bb) / Sin(rt) / Cos(rt)kh(1) = jh_khn(my_gear_data.gm(1), my_gear_data.mh(1), sn(1) '寿命kh(3) = jh_khn(my_gear_data.gm(3), my_gear_data.mh(3), sn(3)ho(1) = jh_ho(my_gear_data.gm(1), my_gear_data.mh(1), my_gear_data.hb(1), my_gear_data.rc(1) '接触疲劳极限ho(3) = jh_ho(my_gear_data.

31、gm(3), my_gear_data.mh(3), my_gear_data.hb(3), my_gear_data.rc(3)hp(1) = kh(1) * ho(1) '接触强度极限hp(3) = kh(3) * ho(3)'按齿跟弯曲疲劳强度设计相关参数 zv(1) = temp_yh_data.z1 / (Cos(temp_yh_data.bt) 3 '当量齿数zv(2) = temp_yh_data.z2 / (Cos(temp_yh_data.bt) 3zv(3) = temp_yh_data.z3 / (Cos(temp_yh_data.bt) 3zv(

32、4) = temp_yh_data.z4 / (Cos(temp_yh_data.bt) 3yf(1) = jh_yf_ys(zv(1).yf: ys(1) = jh_yf_ys(zv(1).ys '齿形系数yf(2) = jh_yf_ys(zv(2).yf: ys(2) = jh_yf_ys(zv(2).ysyf(3) = jh_yf_ys(zv(3).yf: ys(3) = jh_yf_ys(zv(3).ysyf(4) = jh_yf_ys(zv(4).yf: ys(4) = jh_yf_ys(zv(4).ysfo(1) = jh_fo(my_gear_data.gm(1), my

33、_gear_data.mh(1), my_gear_data.hb(1), my_gear_data.rc(1) '齿轮接触疲劳许用应力fo(2) = jh_fo(my_gear_data.gm(2), my_gear_data.mh(2), my_gear_data.hb(2), my_gear_data.rc(2)fo(3) = jh_fo(my_gear_data.gm(3), my_gear_data.mh(3), my_gear_data.hb(3), my_gear_data.rc(3)fo(4) = jh_fo(my_gear_data.gm(4), my_gear_da

34、ta.mh(4), my_gear_data.hb(4), my_gear_data.rc(4)kf(1) = jh_kfn(my_gear_data.gm(1), my_gear_data.mh(1), sn(1) '齿轮弯曲疲劳寿命系数kf(2) = jh_kfn(my_gear_data.gm(2), my_gear_data.mh(2), sn(2)kf(3) = jh_kfn(my_gear_data.gm(3), my_gear_data.mh(3), sn(3)kf(4) = jh_kfn(my_gear_data.gm(4), my_gear_data.mh(4), s

35、n(4)ss = 1.4 '安全系数 fp(1) = kf(1) * fo(1) / ss '齿轮材料弯曲疲劳许用应力fp(2) = kf(2) * fo(2) / ssfp(3) = kf(3) * fo(3) / ssfp(4) = kf(4) * fo(4) / sseb1 = 0.318 * my_gear_data.fd * temp_yh_data.z1 * Tan(temp_yh_data.bt) '轴向重合度tb1 = temp_yh_data.bt * 57.2958 '角度If tb1 > 30 Then tb1 = 30End Ifb

36、e1 = eb1If be1 > 1 Then be1 = 1End Ifyb1 = 1 - be1 * tb1 / 120eb2 = 0.318 * my_gear_data.fd * temp_yh_data.z3 * Tan(temp_yh_data.bt)tb2 = temp_yh_data.bt * 57.2958If tb2 > 30 Then tb2 = 30End Ifbe2 = eb2If be2 > 1 Then be2 = 1End Ifyb2 = 1 - be2 * tb2 / 120'-求约束条件的中间变量-'添加代码bb1 = 2

37、* my_gear_data.kt * t1bb2 = 2 * my_gear_data.kt * t3aa1 = hp(1) 2 * my_gear_data.fd * er1 / (zh * zh) / (ze1 * ze1)aa2 = hp(3) 2 * my_gear_data.fd * er2 * my_gear_data.uu / (zh * zh) / (ze2 / ze2)aa3 = fp(1) * my_gear_data.fd * er1 / (bb1 * yf(1) * ys(1) * yb1)aa4 = fp(2) * my_gear_data.fd * er1 / (

38、bb1 * yf(2) * ys(2) * yb1)aa5 = fp(3) * my_gear_data.fd * er2 / (bb2 * yf(3) * ys(3) * yb2)aa6 = fp(4) * my_gear_data.fd * er2 * my_gear_data.uu / (bb2 * yf(4) * ys(4) * yb2)'-7个约束条件-'添加代码c(1) = aa1 * xp(iiii, 1) 3 * xp(iiii, 2) 3 * xp(iiii, 5) - bb1 * (xp(iiii, 5) + 1) * (Cos(xp(iiii, 6) 3c

39、(2) = aa2 * xp(iiii, 3) 3 * xp(iiii, 4) 3 - bb2 * (xp(iiii, 5) + my_gear_data.uu) * (Cos(xp(iiii, 6) 3c(3) = aa3 * xp(iiii, 1) 3 * xp(iiii, 2) 2 - (Cos(xp(iiii, 6) 2c(4) = aa4 * xp(iiii, 1) 3 * xp(iiii, 2) 2 * xp(iiii, 5) - (Cos(xp(iiii, 6) 2c(5) = aa5 * xp(iiii, 3) 3 * xp(iiii, 4) 2 - (Cos(xp(iiii,

40、 6) 2c(6) = aa6 * xp(iiii, 3) 3 * xp(iiii, 4) 2 - xp(iiii, 5) * (Cos(xp(iiii, 6) 2c7 = 2 * (xp(iiii, 1) + 5) * Cos(xp(iiii, 6) + xp(iiii, 1) * xp(iiii, 2) * xp(iiii, 5)c(7) = xp(iiii, 3) * xp(iiii, 4) * (xp(iiii, 5) + my_gear_data.uu) - xp(iiii, 5) * c7End Sub'弹性影响系数子程序Public Function jh_ze(ggm1

41、 As Integer, ggm2 As Integer) As SingleDim e1 As Single, e2 As Single'添加代码 Select Case ggm1 Case 1 e1 = 206000 Case 2 e1 = 206000 Case 3 e1 = 206000 Case 4 e1 = 202000 Case 5 e1 = 173000 Case 6 e1 = 118000 End Select Select Case ggm2 Case 1 e2 = 206000 Case 2 e2 = 206000 Case 3 e2 = 206000 Case

42、4 e2 = 202000 Case 5 e2 = 173000 Case 6 e2 = 118000 End Selectjh_ze = Sqr(1 / 3.14159265 / (1 - 0.3 2) / e1 + (1 - 0.3 2) / e2) '弹性系数End Function'端面重合度和齿间载荷分配系数er_kr子程序Public Function jh_er_kr(zz1 As Single, zz2 As Single, bt As Single) As erkrDim r As Single, rt As SingleDim x1 As Single, x

43、2 As SingleDim ra(2) As Single'添加代码 r = 20 * 0.017453 rt = Atn(Tan(r) / Cos(bt) x1 = zz1 * Cos(rt) / (zz1 + 2 * Cos(bt) x2 = zz2 * Cos(rt) / (zz2 + 2 * Cos(bt) ra(1) = 1.5707633 - Atn(x1 / Sqr(1 - x1 * x1) ra(2) = 1.5707633 - Atn(x2 / Sqr(1 - x2 * x2) jh_er_kr.er = (zz1 * (Tan(ra(1) - Tan(rt) +

44、zz2 * (Tan(ra(2) - Tan(rt) / 6.2831853 Select Case my_gear_data.gg - 5 Case 1 jh_er_kr.kr = 1.05 + 0.2 * (jh_er_kr.er - 1.2) / 0.8 Case 2 jh_er_kr.kr = 1.1 + 0.4 * (jh_er_kr.er - 1.2) / 0.8 Case 3 jh_er_kr.kr = 1.15 + 0.6 * (jh_er_kr.er - 1.2) / 0.8 Case 4 jh_er_kr.kr = jh_er_kr.er Case 5 jh_er_kr.k

45、r = jh_er_kr.er End SelectEnd Function'齿轮接触疲劳寿命系数khn子程序Public Function khn_ds(nl As Single) As SingleIf my_gear_data.ds = True Then If nl <= 600000! Then khn_ds = 1.6 Exit Function End If If nl >= 1E+09! Then khn_ds = 1! Exit Function End If If nl > 600000! And nl <= 1E+07! Then khn_

46、ds = (3E+08! / nl) 0.0756 Exit Function End If If nl > 1E+07! And nl < 1E+09! Then khn_ds = (1E+09! / nl) 0.057 Exit Function End If If nl <= 100000! Then khn_ds = 1.6 Exit Function End If If nl >= 5E+07! Then khn_ds = 1 Exit Function End If khn_ds = (5E+07! / nl) 0.0756Else If nl <= 100000! Then khn_ds = 1.6 Exit Func