分级变速主传动系统

实验 分级变速主传动系统CAD一、 实验目的1 通过对分级变速主传动系统的设计来巩固课堂学习的相关知识；2 了解和掌握CAD的方法，初步学会应用VB来进行AutoCAD二次开发。二、 实验内容和步骤 实验题目：（参照教材138页） 设计一中型机床传动系统，电动机转速1440rpm，要求输出12级转速、最低转速31.5rpm、最高转速1400rpm。 根据题目要求，工作流程如下： 第一步：输入设计原始数据。主要包括电动机转速、要求输出的转速级数、输出最低转速、输出最高转速等。 第二步：参照教材45页的标准数列表，用写字板等编辑软件，编写标准数列表文件a.dat，并将其存放在程序指定的位置。 第三步：生成符合要求的输出转速序列，相应数据以文件outdata.dat形式输出，并将其存放在程序指定的位置。 以上第一到第三步通过编写QBASIC程序来完成。 第四步：确定传动系统的结构式。 第五步：编程绘制转速图，通过VB编程完成。第六步：完成配齿。以上第四步、第六步由同学们参考教材在课后自己完成。 第七步：绘制传动系统图。由同学们独立完成，可以手绘，也可以在计算机上完成。由以上介绍可以看出，实验课上完成的内容是除第四步和第六步外的全部内容，我们将这些内容分为三大部分。第一部分，包括第一到第三步的全部内容：即利用QBASIC编程，通过运算生成符合题目要求的转速数列等数据，以outdata.dat文件形式输出。QBASIC源程序见下：DIM n(171), Nz(31)OPEN e:a.dat FOR INPUT AS #1i = 1DO WHILE NOT EOF(1)INPUT #1, n(i)i = i + 1LOOPCLOSE #1INPUT nmotor; nmotorINPUT nmin; NminINPUT nmax; nmaxINPUT z; zNz = nmax / Nminng = LOG(Nz)nh = ng / (z - 1)fai = EXP(nh)x = INT(LOG(fai) / LOG(1.06) + .5)FOR i = 1 TO 161IF n(i) = Nmin THEN j = i ELSENEXT iOPEN e:outdata.dat FOR OUTPUT AS #2WRITE #2, nmotorWRITE #2, zFOR k = 1 TO zNz(k) = n(j)j = j + xWRITE #2, Nz(k)NEXT kCLOSE #2END请注意程序中的一句，OPEN e:a.dat FOR INPUT AS #1，这里说明：a.dat文件是标准数列文件，所谓标准数列见教材45页表2.12。这个文件在程序运行前，要编辑好，并放在相应的地方，程序原句要求将a.dat文件放在E盘的根目录下。程序正确运行后自动生成的outdata.dat文件内容见下。14401231.545639012518025035550071010001400以上部分即第一部分用2学时完成。第二部分编写VB程序，绘制转速图，就是第五步工作内容。首先进入VB6.0中文系统，分别制作两个窗体，见图1和图2。 图 1 主控窗体 图 2 绘图参数输入窗体在图 1 的窗体中，“输入转速图绘制所需参数”命令按钮的代码如下：Private Sub Cmd输入参数_Click()Form1.ShowEnd Sub“绘制转速图”命令按钮的代码如下：进入AutoCADPrivate Sub Cmd绘图_Click()On Error Resume NextSet acadapp = GetObject(, autocad.application)If Err Then Err.Clear Set acadapp = CreateObject(autocad.application) If Err Then MsgBox (不能运行AutoCAD200#,请检查是否安装了AutoCAD) Exit Sub End IfEnd If acadapp.Visible = True acadapp.ActiveDocument.ActiveViewport.GridOn = True 画表格Dim lineobj As AcadLineDim startpoint1(0 To 2) As DoubleDim endpoint1(0 To 2) As DoubleDim z As Integerz = 12startpoint1(0) = 1#: startpoint1(1) = 1#: startpoint1(2) = 0#endpoint1(0) = 57#: endpoint1(1) = 1#: endpoint1(2) = 0#:set line1obj= acadapp.ActiveDocument.ModelSpace.AddLine(startpoint1, endpoint1) retval1 = line1obj.ArrayRectangular(z, 1, 1, 6, 0, 0)Dim sp(0 To 2) As DoubleDim ep(0 To 2) As Doublesp(0) = 1#: sp(1) = 1#: sp(2) = 0#ep(0) = 1#: ep(1) = 67#: ep(2) = 0#: Set line2obj = acadapp.ActiveDocument.ModelSpace.AddLine(sp, ep) retval2 = line2obj.ArrayRectangular(1, 5, 1, 1, 14, 0) 写图表标题acadapp.ActiveDocument.ActiveTextStyle.fontFile= c:winntfontssimfang.ttf Dim textobj As AcadText Dim textstring As String Dim ip(0 To 2) As Double Dim iip(0 To 2) As Double Dim h, tx As Double textstring = 分级变速主传动系统转速图 h = 2 ip(0) = 13: ip(1) = -3: ip(2) = 0 Set textobj = acadapp.ActiveDocument.ModelSpace.AddText(textstring, ip, h) acadapp.ActiveDocument.Preferences.LineWeightDisplay = True 从outdata.dat文件中读出相关数据 Open e:outdata.dat For Input As #2 Input #2, n0 Input #2, z For k = 1 To z Input #2, n(k) Next k Close #2 Dim zbj(1 To 5) As String Dim f(1 To 3) As Integer Dim textzh(0 To 2) As Double Dim zip(0 To 2) As Double Dim ziip(0 To 2) As Double Dim ziiip(0 To 2) As Double Dim ziipg(0 To 2) As Double Dim ziiipg(0 To 2) As Double Dim z4p(0 To 2) As Double For m = 1 To 3 For l = 1 To z If drmax(m) = n(l) Then f(m) = l Next l Next m zip(0) = 15#: zip(1) = 1 + 6 * (f(1) - 1): zip(2) = 0 ziip(0) = 29#: ziip(1) = 1 + 6 * (f(2) - 1): ziip(2) = 0 ziipg(0) = ziip(0): ziipg(1) = ziip(1): ziipg(2) = ziip(2) ziiip(0) = 43#: ziiip(1) = 1 + 6 * (f(3) - 1): ziiip(2) = 0 ziiipg(0) = ziiip(0): ziiipg(1) = ziiip(1): ziiipg(2) = ziiip(2) 画电动机到第一传动组的线 Set line0obj = acadapp.ActiveDocument.ModelSpace.AddLine(zip, ep) line0obj.Lineweight = acLnWt050 画第一传动组的三条线 For l = 1 To df(1) Set lineshapeobj = acadapp.ActiveDocument.ModelSpace.AddLine(zip, ziipg) lineshapeobj.Lineweight = acLnWt050 ziipg(1) = ziipg(1) - 6 * js(1) Next l 画第二传动组的六条线 Set lineshape21obj = acadapp.ActiveDocument.ModelSpace.AddLine(ziip, ziiip) lineshape21obj.Lineweight = acLnWt050 ziiip(1) = ziiip(1) - 6 * js(2) Set lineshape22obj = acadapp.ActiveDocument.ModelSpace.AddLine(ziip, ziiip) lineshape22obj.Lineweight = acLnWt050 retval3 = lineshape21obj.ArrayRectangular(js(2), 1, 1, -6, 0, 0) retval4 = lineshape22obj.ArrayRectangular(js(2), 1, 1, -6, 0, 0) ziiip点坐标恢复原值 ziiip(1) = ziiip(1) + 6 * js(2) 画第三传动组的十二条线 z4p(0) = 1 + 14 * (ds - 1): z4p(1) = 1 + 6 * (z - 1): z4p(2) = 0Setlineshape31obj= acadapp.ActiveDocument.ModelSpace.AddLine(ziiipg, z4p) lineshape31obj.Lineweight = acLnWt050 z4p(1) = z4p(1) - 6 * js(3) Set lineshape32obj = acadapp.ActiveDocument.ModelSpace.AddLine(ziiipg, z4p) lineshape32obj.Lineweight = acLnWt050 retval5 = lineshape31obj.ArrayRectangular(js(3), 1, 1, -6, 0, 0) retval6 = lineshape32obj.ArrayRectangular(js(3), 1, 1, -6, 0, 0) z4p点坐标恢复原值 z4p(1) = z4p(1) + 6 * js(3) 画圆 Dim r As Double Dim hatchobj As AcadHatch Dim hatchobj1 As AcadHatch Dim hatchobj2 As AcadHatch Dim patternname As String Dim patterntype As Long Dim bassociativity As Boolean r = 0.5 patterntype = 0 patternname = solid bassociativity = True Set hatchobj = acadapp.ActiveDocument.ModelSpace.AddHatch(patterntype, patternname, bassociativity)Set hatchobj1= acadapp.ActiveDocument.ModelSpace.AddHatch(patterntype, atternname, bassociativity) Set hatchobj2 = acadapp.ActiveDocument.ModelSpace.AddHatch(patterntype, patternname, bassociativity) Set hatchobj3 = acadapp.ActiveDocument.ModelSpace.AddHatch(patterntype, patternname, bassociativity) Dim outerloop(0 To 0) As AcadEntity Dim outerloop1(0 To 0) As AcadEntity Dim outerloop2(0 To 0) As AcadEntity Dim outerloop3(0 To 0) As AcadEntity Set outerloop(0) = acadapp.ActiveDocument.ModelSpace.AddCircle(ep, r) hatchobj.AppendOuterLoop (outerloop) Set outerloop(0) = acadapp.ActiveDocument.ModelSpace.AddCircle(zip, r) hatchobj.AppendOuterLoop (outerloop) Set outerloop1(0) = acadapp.ActiveDocument.ModelSpace.AddCircle(ziip, r) hatchobj1.AppendOuterLoop (outerloop1) retval11 = hatchobj1.ArrayRectangular(3, 1, 1, -6, 0, 0) Debug.Print ziiip(1)=; ziiip(1) Set outerloop2(0) = acadapp.ActiveDocument.ModelSpace.AddCircle(ziiip, r) hatchobj2.AppendOuterLoop (outerloop2) retval12 = hatchobj2.ArrayRectangular(6, 1, 1, -6, 0, 0) Set outerloop3(0) = acadapp.ActiveDocument.ModelSpace.AddCircle(z4p, r) hatchobj3.AppendOuterLoop (outerloop3) retval13 = hatchobj3.ArrayRectangular(z, 1, 1, -6, 0, 0) hatchobj.Evaluate acadapp.ActiveDocument.Regen True 写图中文字 iip(0) = 58.5: iip(1) = -6: iip(2) = 0 For j = 1 To z tx = n(j) iip(1) = iip(1) + 6 Set Text = acadapp.ActiveDocument.ModelSpace.AddText(tx, iip, h) Next j Dim textjz(0 To 2) As Double textjz(0) = -6: textjz(1) = 66: textjz(2) = 0 Set Text = acadapp.ActiveDocument.ModelSpace.AddText(n0, textjz, h) textjz(0) = 1: textjz(1) = 68: textjz(2) = 0 zbj(1) = 电动机: zbj(2) = I: zbj(3) = II: zbj(4) = III: zbj(5) = IV textjz(0) = -3: textjz(1) = 69 For i = 1 To 5 Set Text = acadapp.ActiveDocument.ModelSpace.AddText(zbj(i), textjz, h) If i = 3 Then textjz(0) = textjz(0) + 4 If i = 4 Then textjz(0) = textjz(0) + 8 textjz(0) = textjz(0) + 17.5 - 4 * (i - 1) Next i ZoomExtentsEnd Sub “退出”命令按钮的代码如下：Private Sub Cmd退出_Click()EndEnd Sub在图 2 的窗体中，“确定”命令按钮的代码如下：Private Sub Cmd确定_Click()mrpm = CInt(Text1.Text)ds = CInt(Text2.Text)dg = CInt(Text3.Text)df(1) = CInt(Text4.Text)js(1) = CInt(Text5.Text)drmax(1) = CInt(Text6.Text)radmax(1) = CDbl(Text7.Text)df(2) = CInt(Text8.Text)js(2) = CInt(Text9.Text)drmax(2) = CInt(Tex