机械原理凸轮VB编程

1、精选优质文档-倾情为你奉上理论轮廓线与工作轮廓线Dim r0 As Double '定义基圆半径Dim e As Double '定义偏心距Dim h As Double '定义行程Dim f As Double '定义凸轮转角Dim ff As DoubleDim w As Double '定义凸轮角速度Dim f0 As Double '定义推程运动角Dim fs As Double '定义远休止角Dim f01 As Double '定义回程运动角Dim fs1 As Double '定义近休止角Dim s As D

2、ouble '定义从动件位移Dim v As Double '定义从动件速度Dim a As Double '定义从动件加速度Dim x As Double '定义凸轮理论轮廓上点横坐标Dim y As Double '定义凸轮理论轮廓上点纵坐标Dim x1 As Double '定义凸轮实际轮廓上点横坐标Dim y1 As Double '定义凸轮实际轮廓上点纵坐标Dim rr As Double '定义滚子半径Dim pi As Double '定义圆周率Dim pa As Double '定义角度弧度转换中间

3、变量Dim T As Double '定义中间变量Dim s0 As Double '定义中间变量Dim i As Double '定义中间变量Dim dsdf As Double '定义ds/dfDim dxdf As Double '定义dx/dfDim dydf As Double '定义dy/dfPrivate Sub push()If f >= 0 And f <= f0 / 2 Thens = 2 * h * (f / f0) 2v = 4 * h * w * f / f0 2a = 4 * h * w 2 / f0 2d

4、sdf = 4 * h * f / f0 2End IfIf f >= f0 / 2 And f <= f0 Thens = h - 2 * h * (f0 - f) 2 / f0 2v = 4 * h * w * (f0 - f) / f0 2a = -4 * h * w 2 / f0 2dsdf = 4 * h * (f0 - f) / f0 2End IfEnd SubPrivate Sub back()If f >= f0 + fs And f <= f0 + fs + f01 / 2 Thens = h - 2 * h * (f - (f0 + fs) 2 /

5、 f01 2v = -4 * h * w * (f - (f0 + fs) / f01 2a = -4 * h * w 2 / f01 2dsdf = -4 * h * (f - (f0 + fs) / f01 2End IfIf f >= f0 + fs + f01 / 2 And f <= f0 + fs + f01 Thens = 2 * h * (f0 + fs + f01) - f) 2 / f01 2v = -4 * h * w * (f0 + fs + f01) - f) / f01 2a = 4 * h * w 2 / f01 2dsdf = -4 * h * (f

6、0 + fs + f01) - f) / f01 2End IfEnd SubPrivate Sub pushstay()s = hv = 0a = 0dsdf = 0End SubPrivate Sub backstay()s = 0v = 0a = 0dsdf = 0End SubPrivate Sub Command1_Click()Picture1.ClsPicture1.Scale (-30, 110)-(390, -20) Picture1.Line (-30, 0)-(390, 0) 'X Picture1.Line (0, 390)-(0, -20) 'Y Fo

7、r i = 0 To 360 Step 30 'X轴坐标 Picture1.Line (i, 2)-(i, 0) Picture1.CurrentX = i - 10: Picture1.CurrentY = 0 Picture1.Print i Next i For i = 10 To 110 Step 10 'Y轴坐标 Picture1.Line (0, i)-(5, i) Picture1.CurrentX = -30: Picture1.CurrentY = i + 2 Picture1.Print i Next i For ff = 0 To 360 Step 0.1

8、 f = ff s0 = Sqr(r0 2 - e 2) If f < f0 Then Call push ElseIf f >= f0 And f < fs + f0 Then Call pushstay ElseIf f >= fs + f0 And f < fs + f0 + f01 Then Call back ElseIf f >= fs + f0 + f01 And f <= 2 * pi Then Call backstay End If Picture1.PSet (ff, s) Next ffEnd SubPrivate Sub Co

9、mmand2_Click()Picture1.ClsPicture1.Scale (-30, 30)-(390, -30) Picture1.Line (-30, 0)-(390, 0) 'X Picture1.Line (0, 390)-(0, -30) 'Y For i = 0 To 360 Step 30 'X轴坐标 Picture1.Line (i, 0.5)-(i, 0) Picture1.CurrentX = i - 10: Picture1.CurrentY = 0 Picture1.Print i Next i For i = -100 To 30 St

10、ep 10 'Y轴坐标 Picture1.Line (0, i)-(5, i) Picture1.CurrentX = -20: Picture1.CurrentY = i + 3 Picture1.Print i Next i For ff = 0 To 360 Step 0.1 f = ff If f < f0 Then Call push ElseIf f >= f0 And f < fs + f0 Then Call pushstay ElseIf f >= fs + f0 And f < fs + f0 + f01 Then Call back

11、ElseIf f >= fs + f0 + f01 And f <= 360 Then Call backstay End If Picture1.PSet (ff, v) Next ffEnd SubPrivate Sub Command3_Click()Picture1.ClsPicture1.Scale (-30, 10)-(390, -10) Picture1.Line (-30, 0)-(390, 0) 'X Picture1.Line (0, 10)-(0, -10) 'Y For i = 0 To 360 Step 30 'X轴坐标 Pictu

12、re1.Line (i, 0.25)-(i, 0) Picture1.CurrentX = i - 10: Picture1.CurrentY = 0 Picture1.Print i Next i For i = -10 To 10 Step 2 'Y轴坐标 Picture1.Line (0, i)-(5, i) Picture1.CurrentX = -20: Picture1.CurrentY = i + 1 Picture1.Print i Next i For ff = 0 To 360 Step 0.1 f = ff If f < f0 Then Call push

13、ElseIf f >= f0 And f < fs + f0 Then Call pushstay ElseIf f >= fs + f0 And f < fs + f0 + f01 Then Call back ElseIf f >= fs + f0 + f01 And f <= 360 Then Call backstay End If Picture1.PSet (ff, a) Next ffEnd SubPrivate Sub Command4_Click()Picture1.ClsPicture1.Scale (-150, 150)-(150, -

14、150) Picture1.Line (-150, 0)-(150, 0) 'X Picture1.Line (0, 150)-(0, -150) 'Y For i = -150 To 150 Step 10 'X轴坐标 Picture1.Line (i, 2)-(i, 0) Picture1.CurrentX = i - 5: Picture1.CurrentY = 0 Picture1.Print i Next i For i = -150 To 150 Step 10 'Y轴坐标 Picture1.Line (0, i)-(4, i) Picture1.C

15、urrentX = -13: Picture1.CurrentY = i + 5 Picture1.Print i Next i f0 = f0 * pa fs = fs * pa f01 = f01 * pa For ff = 0 To 360 Step 0.1 f = ff * pa If f < f0 Then Call push ElseIf f >= f0 And f < fs + f0 Then Call pushstay ElseIf f >= fs + f0 And f < fs + f0 + f01 Then Call back ElseIf f

16、 >= fs + f0 + f01 And f <= 360 Then Call backstay End If Picture1.PSet (-dsdf, s) Next ffEnd SubPrivate Sub Command5_Click()Picture1.ClsPicture1.Scale (-200, 200)-(200, -200) Picture1.Line (-200, 0)-(200, 0) 'X Picture1.Line (0, 200)-(0, -200) 'Y For i = -200 To 200 Step 20 'X轴坐标 P

17、icture1.Line (i, 2)-(i, 0) Picture1.CurrentX = i - 10: Picture1.CurrentY = 0 Picture1.Print i Next i For i = -200 To 200 Step 20 'Y轴坐标 Picture1.Line (0, i)-(5, i) Picture1.CurrentX = -10: Picture1.CurrentY = i + 2 Picture1.Print i Next i f0 = f0 * pa fs = fs * pa f01 = f01 * pa For ff = 0 To 360

18、 Step 0.1 f = ff * pa s0 = 70 If f < f0 Then Call push ElseIf f >= f0 And f < fs + f0 Then Call pushstay ElseIf f >= fs + f0 And f < fs + f0 + f01 Then Call back ElseIf f >= fs + f0 + f01 And f <= 2 * pi Then Call backstay End If x = (s + s0) * Cos(f) - e * Sin(f) y = (s + s0) *

19、 Sin(f) + e * Cos(f) dxdf = -(s0 + s) * Sin(f) - e * Cos(f) dydf = (s0 + s) * Cos(f) - e * Sin(f) x1 = x + rr * dydf / Sqr(dxdf 2 + dydf 2) y1 = y - rr * dxdf / Sqr(dxdf 2 + dydf 2) Picture1.PSet (x, y) Picture1.PSet (x1, y1) Picture1.PSet (r0 * Cos(f), r0 * Sin(f) Next ffEnd SubPrivate Sub Form_Loa

20、d()pi = 3.pa = pi / 180h = 80f0 = 90fs = 100f01 = 80fs1 = 90w = 10e = 40r0 = 80.623rr = 10End SubDim xB As Double 'B点 x轴坐标Dim yB As Double 'B点y轴坐标Dim vxB As Double 'B点速度x轴分量Dim vyB As Double 'B点速度y轴分量Dim axB As Double 'B点加速度x轴分量Dim ayB As Double 'B点加速度y轴分量Dim xC As Double 

21、9;C点x轴坐标Dim yC As Double 'C点y轴坐标Dim vxC As Double 'C点速度x轴分量Dim vyC As Double 'C点速度y轴分量Dim axC As Double 'C点加速度x轴分量Dim ayC As Double 'C点加速度y轴分量Dim xD As Double 'D点x轴坐标Dim yD As Double 'D点y轴坐标Dim vxD As Double 'D点速度x轴分量Dim vyD As Double 'D点速度y轴分量Dim axD As Double &#

22、39;D点加速度x轴分量Dim ayD As Double 'D点加速度y轴分量Dim xE As DoubleDim yE As DoubleDim vxE As DoubleDim vyE As DoubleDim axE As Double 'E点加速度x轴分量Dim ayE As Double 'E点加速度y轴分Dim xF As Double 'F点x轴坐标Dim yF As Double 'F点y轴坐标Dim vxF As Double 'F点速度x轴分量Dim vyF As Double 'F点速度y轴分量Dim axF A

23、s Double 'F点加速度x轴分量Dim ayF As Double 'F点加速度y轴分量Dim l1 As Double 'ab杆长Dim l2 As Double 'bc杆长Dim l3 As Double 'cd杆长Dim l4 As Double 'ef杆长Dim delt As DoubleDim delt1 As DoubleDim f1 As Double 'ab杆转角Dim w1 As Double 'ab杆角速度Dim e1 As Double 'ab杆角加速度Dim LBD As Double &#

24、39;bd距离Dim val As Double 'cosCBDDim JCBD As Double '角BDEDim fDB As Double 'de角Dim f2 As Double 'bc杆位置角Dim f3 As Double 'cd杆位置角Dim e2 As Double ' bc杆角加速度Dim e3 As Double ' cd杆角加速度Dim C2 As DoubleDim C3 As DoubleDim S2 As DoubleDim S3 As DoubleDim G1 As DoubleDim G2 As Doub

25、leDim G3 As DoubleDim w2 As Double 'bc杆角速度Dim w3 As Double ' cd角速度Dim f4 As Double 'ef杆位置角Dim l As DoubleDim lj As DoubleDim wj As DoubleDim ej As DoubleDim fj As Double 'eg转角Dim w4 As Double ' ef角速度Dim e4 As Double 'ef杆角加速度Dim xK As DoubleDim yK As DoubleDim vxK As DoubleDim

26、 vyK As DoubleDim axK As DoubleDim ayK As DoubleDim ss As DoubleDim vss As DoubleDim ass As DoubleDim A0 As DoubleDim Q1 As DoubleDim Q2 As DoubleDim Q3 As DoubleDim Q4 As DoubleDim Q5 As DoubleDim val1 As DoubleDim xp As Double 'p点x轴坐标Dim yp As Double 'p点y轴坐标Dim vxp As Double 'p点速度x轴分量D

27、im vyp As Double 'p点速度y轴分量Dim axp As Double 'p点加速度x轴分量Dim ayp As Double 'p点加速度y轴分量Dim pi As DoubleDim pa As DoubleDim i As DoubleDim fj1 As DoublePrivate Sub Command1_Click() '求点F的轨迹Picture1.Scale (0, 800)-(400, 0)Picture1.Line (0, 0)-(400, 0) 'XPicture1.Line (0, 800)-(0, 0) '

28、;YFor i = 0 To 400 Step 50 'X轴坐标 Picture1.DrawStyle = 2 Picture1.Line (i, 0)-(i, 800) Picture1.CurrentX = i - 0: Picture1.CurrentY = 0 Picture1.Print i Next iFor i = 0 To 800 Step 50 'Y轴坐标 Picture1.DrawStyle = 2 Picture1.Line (0, i)-(400, i) Picture1.CurrentX = -20: Picture1.CurrentY = i + 7

29、 Picture1.Print i Next iFor fj1 = 0 To 360 Step 0.01 f1 = fj1 * paCall RRCall RRRCall RR1Call RRP Picture1.PSet (xF, yF) Next fj1End SubPrivate Sub Command2_Click() '求点F的速度Picture2.Scale (0, 800)-(400, -800)Picture2.Line (0, 0)-(400, 0) 'XPicture2.Line (0, 800)-(0, -800) 'YFor i = 0 To 4

30、00 Step 50 'X轴坐标 Picture2.DrawStyle = 2 Picture2.Line (i, 800)-(i, -800) Picture2.CurrentX = i - 10: Picture3.CurrentY = 0 Picture2.Print i Next iFor i = 0 To 800 Step 50 'Y轴坐标 Picture2.Line (0, i)-(400, i) Picture2.CurrentX = -28: Picture2.CurrentY = i Picture2.Print i Next iFor fj1 = 0 To

31、360 Step 0.01 f1 = fj1 * paCall RRCall RRRCall RR1Call RRP Picture2.PSet (fj1, vxF)Next fj1End SubPrivate Sub Command3_Click() '求点F的加速度Picture3.Scale (0, 3000)-(400, -5000)Picture3.Line (0, 0)-(500, 0) 'XPicture3.Line (0, 3000)-(0, -5000) 'YFor i = 0 To 360 Step 50 'X轴坐标 Picture3.Dra

32、wStyle = 2 Picture3.Line (i, 3000)-(i, -5000) Picture3.CurrentX = i - 10: Picture3.CurrentY = 0 Picture3.Print i Next iFor i = -5000 To 3000 Step 50 'Y轴坐标 Picture3.Line (0, i)-(400, i) Picture3.CurrentX = -25: Picture3.CurrentY = i + 5 Picture3.Print i Next iFor fj1 = 0 To 360 Step 0.01 f1 = fj1

33、 * pa Call RR Call RRR Call RR1 Call RRP Picture3.PSet (fj1, axF)Next fj1End SubPrivate Sub Form_Load() '赋初值l1 = 150l2 = 600l3 = 500l4 = 600yF = 600w1 = 5.23l = 120xD = 400yD = 500vxD = 0vyD = 0axD = 0ayD = 0vyF = 0ayF = 0delt = 0delt1 = 0e1 = 0lj = 0fj = 0wj = 0ej = 0xK = 500yK = 600vxK = 0vyK

34、= 0axK = 0ayK = 0pi = 3.14pa = pi / 180End SubPrivate Sub RR() 'RR基本杆组xB = l1 * Cos(f1 + delt)yB = l1 * Sin(f1 + delt)vxB = -w1 * l1 * Sin(f1 + delt)vyB = w1 * l1 * Cos(f1 + delt)axB = -w1 2 * l1 * Cos(f1 + delt) - e1 * l1 * Sin(f1 + delt)ayB = -w1 2 * l1 * Sin(f1 + delt) + e1 * l1 * Cos(f1 + de

35、lt)End SubPrivate Sub RRR() 'RRR基本杆组LBD = Sqr(xD - xB) 2 + (yD - yB) 2)If LBD > l2 + l3 And LBD < Abs(l2 - l3) Then If MsgBox("RRR杆组杆长不符合要求", vbOKOnly, "提示") = 1 Then End Else End IfElseEnd IfIf LBD < l3 + l2 And LBD > Abs(l3 - l2) Then val = (l2 2 + LBD 2 - l3 2)

36、 / (2 * l2 * LBD) JCBD = Atn(-val / Sqr(-val * val + 1) + 2 * Atn(1)ElseEnd IfIf LBD = l3 + l2 Then JCBD = 0 Else End IfIf LBD = Abs(l3 - l2) Then If l2 > l3 Then JCBD = 0 Else End If If l2 < l3 Then JCBD = pi Else End If Else End If If xD > xB And yD >= yB Then '第一象限 fDB = Atn(yD -

37、yB) / (xD - xB) Else End If If xD = xB And yD > yB Then fDB = pi / 2 Else End If If xD < xB And yD >= yB Then '第二象限 fDB = pi + Atn(yD - yB) / (xD - xB) Else End If If xD < xB And yD < yB Then '第三象限 fDB = pi + Atn(yD - yB) / (xD - xB) Else End If If xD = xB And yD < yB Then

38、fDB = 3 * pi / 2 Else End If If xD > xB And yD <= yB Then '第四象限 fDB = 2 * pi + Atn(yD - yB) / (xD - xB) Else End Iff2 = fDB + JCBDxC = xB + l2 * Cos(f2)yC = yB + l2 * Sin(f2)If xC > xD And yC >= yD Then '第一象限f3 = Atn(yC - yD) / (xC - xD)Else End If If xC = xD And yC > yD Then

39、f3 = pi / 2 Else End If If xC < xD And yC >= yD Then '第二象限 f3 = pi + Atn(yC - yD) / (xC - xD) Else End If If xC < xD And yC < yD Then '第三象限 f3 = pi + Atn(yC - yD) / (xC - xD) Else End If If xC = xD And yC < yD Then f2 = 3 * pi / 2 Else End If If xC > xD And yC <= yD Then

40、 '第四象限 f2 = 2 * pi + Atn(yC - yD) / (xC - xD) Else End If C2 = l2 * Cos(f2)S2 = l2 * Sin(f2)C3 = l3 * Cos(f3)S3 = l3 * Sin(f3)G1 = C2 * S3 - C3 * S2w2 = (C3 * (vxD - vxB) + S3 * (vyD - vyB) / G1w3 = (C2 * (vxD - vxB) + S2 * (vyD - vyB) / G1vxC = vxB - w2 * l2 * Sin(f2)vyC = vyB + w2 * l2 * Cos(f

41、2)G2 = axD - axB + w2 2 * C2 - w3 2 * C3G3 = ayD - ayB + w2 2 * S2 - w3 2 * S3e2 = (G2 * C2 + G3 * S3) / G1e3 = (G2 * C2 + G3 * S2) / G1axC = axB - e2 * l2 * Sin(f2) - w2 2 * l2 * Cos(f2)ayC = ayB + e2 * l2 * Cos(f2) - w2 2 * l2 * Sin(f2) End SubPrivate Sub RR1() 'RR1基本杆组xE = xC + l * Cos(f2 + delt1)yE = yC + l * Sin(f2 + delt1)vxE = vxC - w2 * l * Sin(f2 + delt1)vyE = vyC + w2 * l2 * Cos(f2 + delt1)axE = axC - w2 2 * l * Cos(f2 + delt1) - e2 * l * Sin(f2 + delt1)ayE