jixiesheji.rar_凸轮_机械

Option Explicit Public dblRO As Double, dblRr As Double, dblh As Double Public dblFO As Double, dblL_OA As Double, dblW As Double Public dblAngleT As Double, dblAngleYX As Double, dblAngleH As Double Public intCW As Integer, intIO As Double Public Const PI As Double = 3.1415926 '//////////////////////////////////////////////////////////////////////////// '////////////////////////////////////////////////////////////////////////////// 'FWE模块中的FWE过程 Public Sub FWE(i, dblS, dblV, dblA) Dim intMark As Integer If i = 360 Then i = 0 intMark = 1 End If Select Case i Case Is < dblAngleT '推程 If frmMain.cboTCh.Text = "等加速等减速" Then Call TCh.Tacc(i, dblS, dblV, dblA) Case dblAngleT To dblAngleT + dblAngleYX '远休 dblS = dblh dblV = 0 dblA = 0 Case dblAngleT + dblAngleYX + 1 To dblAngleT + dblAngleYX + dblAngleH - 1 '回程 If frmMain.cboHCh.Text = "正弦加速度" Then Call HCh.Hsin(i, dblS, dblV, dblA) Case Else '近休 dblS = 0 dblV = 0 dblA = 0 End Select If intMark = 1 Then i = 360 End Sub '/////////////////////////////////////////////////////////////////////////// '/////////////////////////////////////////////////////////////////////////// 'THC模块,对推程进行运动分析 'THC模块中的Tacc过程，适用于推程为等加速等减速运动的情况 Public Sub Tacc(dblf, dblS, dblV, dblA) If dblf <= dblAngleT / 2 Then dblS = 2 * h * dblf ^ 2 / dblAngleT ^ 2 dblV = 4 * dblh * dblf / dblAngleT ^ 2 dblA = 4 * dblh / dblAngleT ^ 2 Else dblS = dblh - 2 * dblh * ((dblAngleT - dblf) ^ 2) / dblAngleT ^ 2 dblV = 4 * dblh * (dblAngleT - dblf) / dblAngleT ^ 2 dblA = -4 * dblh / dblAngleT ^ 2 End If End Sub '/////////////////////////////////////////////////////////////////////////// '/////////////////////////////////////////////////////////////////////////// 'Hch模块，对回程进行运动分析 'Hch模块中的Hsin过程，适用于回程为正弦加速度运动的情况 Public Sub Hsin(dblf, dblS, dblV, dblA) dblS = dblh * (1 - dblf / dblAngleH + Sin(2 * PI * dblf / dblAngleH) / 2 * PI) dblV = -dblh / dblAngleH * (1 - Cos(2 * PI * dblf / dblAngleH)) dblA = -2 * PI * dblh * Sin(2 * PI * dblf / dblAngleH) / dblAngleH ^ 2 End Sub 'KSDH模块中的DH过程，用于绘制凸轮廓形，进行运动仿真 Public Sub DH(j, dblsxy) picPlay.FillStyle = vbFSTransparent picPlay.FillColor = vbBlack Dim dblS As Double, dblV As Double, dblA As Double '画摆杆、滚子 Call FWE(j, dblS, dblV, dblA) picPlay.Line (dblE * dblsxy, (dblS + Sqr(dblRO ^ 2 - dblE ^ 2)) * dblsxy)-(dblE * dblsxy, Sqr(dblRO ^ 2 - dblE ^ 2) * dblsxy + 80 * dblsxy) picPlay.Circle (dblE * dblsxy, (dblS + Sqr(dblRO ^ 2 - dblE ^ 2)) * dblsxy), dblRr * dblsxy '画基圆 picPlay.DrawWidth = 1 picPlay.Circle (0, 0), dblRO * dblsxy '画铰链 picPlay.DrawWidth = 1.5 picPlay.FillStyle = vbFSSolid picPlay.FillColor = vbRed picPlay.Circle (0, 0), 5 * dblsxy picPlay.Circle (dblE * dblsxy, (dblS + Sqr(dblRO ^ 2 - dblE ^ 2)) * dblsxy), 4 * dblsxy '画机架 picPlay.Line (dblE * dblsxy - 3 * dblsxy, Sqr(dblRO ^ 2 - dblE ^ 2) * dblsxy + 80 * dblsxy)-(dblE * dblsxy - 3 * dblsxy, Sqr(dblRO ^ 2 - dblE ^ 2) * dblsxy + 60 * dblsxy) picPlay.Line (dblE * dblsxy + 3 * dblsxy, Sqr(dblRO ^ 2 - dblE ^ 2) * dblsxy + 80 * dblsxy)-(dblE * dblsxy + 3 * dblsxy, Sqr(dblRO ^ 2 - dblE ^ 2) * dblsxy + 60 * dblsxy) picPlay.Line (dblE * dblsxy - 3 * dblsxy, Sqr(dblRO ^ 2 - dblE ^ 2) * dblsxy + 79 * dblsxy)-(dblE * dblsxy - 7 * dblsxy, Sqr(dblRO ^ 2 - dblE ^ 2) * dblsxy + 65 * dblsxy) picPlay.Line (dblE * dblsxy - 3 * dblsxy, Sqr(dblRO ^ 2 - dblE ^ 2) * dblsxy + 70 * dblsxy)-(dblE * dblsxy - 7 * dblsxy, Sqr(dblRO ^ 2 - dblE ^ 2) * dblsxy + 56 * dblsxy) picPlay.Line (dblE * dblsxy + 3 * dblsxy, Sqr(dblRO ^ 2 - dblE ^ 2) * dblsxy + 76 * dblsxy)-(dblE * dblsxy + 7 * dblsxy, Sqr(dblRO ^ 2 - dblE ^ 2) * dblsxy + 85 * dblsxy) picPlay.Line (dblE * dblsxy + 3 * dblsxy, Sqr(dblRO ^ 2 - dblE ^ 2) * dblsxy + 66 * dblsxy)-(dblE * dblsxy + 7 * dblsxy, Sqr(dblRO ^ 2 - dblE ^ 2) * dblsxy + 75 * dblsxy) picPlay.Line (-15 * dblsxy, -10 * dblsxy)-(15 * dblsxy, -10 * dblsxy) picPlay.Line (-10 * dblsxy, -10 * dblsxy)-(-3 * dblsxy, -4 * dblsxy) picPlay.Line (10 * dblsxy, -10 * dblsxy)-(3 * dblsxy, -4 * dblsxy) picPlay.Line (-10 * dblsxy, -10 * dblsxy)-(-14 * dblsxy, -13 * dblsxy) picPlay.Line (0, -10 * dblsxy)-(-4 * dblsxy, -13 * dblsxy) picPlay.Line (10 * dblsxy, -10 * dblsxy)-(6 * dblsxy, -13 * dblsxy) '画凸轮轮廓 picPlay.FillStyle = vbFSTransparent picPlay.FillColor = vbBlack Dim m As Double, n As Double, s0 As Double, dblf As Integer Dim X As Double, Y As Double, xx As Double, yy As Double Dim dbltempcos As Double, dbltempsin As Double Dim X1 As Double, Y1 As Double, xx1 As Double, yy1 As Double dbltempcos = Cos(j * PI / 180) dbltempsin = Sin(j * PI / 180) For dblf = 0 To 360 Call FWE(dblf, dblS, dblV, dblA) s0 = Sqr(dblRO ^ 2 - dblE ^ 2) X = (dblS + s0) * Sin(dblf * PI / 180) + dblE * Cos(dblf * PI / 180) Y = (dblS + s0) * Cos(dblf * PI / 180) - dblE * Sin(dblf * PI / 180) xx = X * dbltempcos - Y * dbltempsin yy = Y * dbltempcos + X * dbltempsin picPlay.DrawWidth = 1 picPlay.PSet (xx * dblsxy, yy * dblsxy) m = (dblS + s0) * Cos(dblf * PI / 180) + dblV * Sin(dblf * PI / 180) - dblE * Sin(dblf * PI / 180) n = (dblV - dblE) * Cos(dblf * PI / 180) - (dblS + s0) * Sin(dblf * PI / 180) X1 = X + n * dblRr / Sqr(m ^ 2 + n ^ 2) Y1 = Y - m * dblRr / Sqr(m ^ 2 + n ^ 2) picPlay.DrawWidth = 1.5 xx1 = X1 * dbltempcos - Y1 * dbltempsin yy1 = Y1 * dbltempcos + X1 * dbltempsin picPlay.PSet (xx1 * dblsxy, yy1 * dblsxy) Next dblf End Sub