frm凸轮设计.frm

visual basic程序实现凸轮机构设计

            Name            =   "宋体"
            Size            =   12
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00FFFF00&
         Height          =   255
         Left            =   4680
         TabIndex        =   5
         Top             =   2640
         Visible         =   0   'False
         Width           =   255
      End
   End
End
Attribute VB_Name = "frm凸轮设计"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim ii As Integer
Dim jj As Integer
Dim δ As Single
Public Sub cmdReset_Click()
   Call init1
End Sub

Private Sub cmd继续_Click()
    Dim i As Integer
    If δ = 0 Then
        Line1.Visible = False
        Line2.Visible = False
        Line3.Visible = False
        Line4.Visible = False
        Line5.Visible = False
        Lineh1.Visible = False
        Lineh2.Visible = False
        Label1.Visible = False
        Label2.Visible = False
        Label3.Visible = False
        Label4.Visible = False
        lab_h.Visible = False
         If i等分DT0 <> 0 Then
        For i = 1 To i等分DT0
            lin凸轮DT0(i).Visible = False
            lin基圆DT0(i).Visible = False
            lin等分DT0(i).Visible = False
        Next
        End If
    
        If i等分DT2 <> 0 Then
        For i = 1 To i等分DT2
            lin凸轮DT2(i).Visible = False
            lin基圆DT2(i).Visible = False
            lin等分DT2(i).Visible = False
        Next
        End If
    
    End If
    
    cmd继续.Caption = "暂停"
    If Timer1.Enabled Then cmd继续.Caption = "继续"
    Timer1.Enabled = Not Timer1.Enabled
End Sub

Private Sub cmd设计_Click()
    Dim i As Integer
    'Cls
    Call init1
'     If i等分DT0 <> 0 Then
'        For i = 1 To i等分DT0
'            lin凸轮DT0(i).Visible = False
'            lin基圆DT0(i).Visible = False
'            lin等分DT0(i).Visible = False
'        Next
'        End If
'
'        If i等分DT2 <> 0 Then
'        For i = 1 To i等分DT2
'            lin凸轮DT2(i).Visible = False
'            lin基圆DT2(i).Visible = False
'            lin等分DT2(i).Visible = False
'        Next
'        End If
    If e = 0 Then
        If r1 = 0 Then frm对心设计.cmdFifth.Enabled = False
        frm对心设计.Show
    Else
        If r1 = 0 Then frm偏置设计.cmdSixth.Enabled = False
        frm偏置设计.Show
    End If
End Sub

Private Sub cmd设置_Click()
    frm设置.Show
End Sub

Private Sub cmd退出_Click()
    End
End Sub


Private Sub Form_Load()
    'Me.Height = 8000
    'Me.Width = 8000
    'Picture1.DrawWidth = 1
    Call init1
End Sub


Private Sub Form_Unload(Cancel As Integer)
    End
End Sub

Private Sub Timer1_Timer()
    Dim i As Integer
    Picture1.Cls
    
     '画基圆和回转中心
    Picture1.DrawWidth = 1
    Picture1.Circle (x0, y0), r0, &HFF&
    Picture1.Circle (x0, y0), 10, &HFFFF&
    
    '画凸轮
    For i = 0 To 360 Step 1
    
        '理论轮廓
        CurrentXY(1) = PointXY(i, 1) - x0
        CurrentXY(2) = PointXY(i, 2) - y0
        PointXY(i, 1) = CurrentXY(1) * Cosδθ - CurrentXY(2) * sinδθ + x0
        PointXY(i, 2) = CurrentXY(1) * sinδθ + CurrentXY(2) * Cosδθ + y0
        Picture1.DrawWidth = 1
        If i = 0 Then
            Picture1.PSet (PointXY(i, 1), PointXY(i, 2))
        Else
            Picture1.Line (PointXY(i - 1, 1), PointXY(i - 1, 2))-(PointXY(i, 1), PointXY(i, 2)), &H80FF&
            'Picture1.Line -(PointXY(i, 1), PointXY(i, 2)), &H80FF&
        End If
        
        If ((i = 0) Or (i = δ0) Or (i = δ0 + δ1) Or (i = δ0 + δ1 + δ2)) Then
            Picture1.Line (x0, y0)-(PointXY(i, 1), PointXY(i, 2)), &HFF00FF
        End If
        
        '实际轮廓
        Picture1.DrawWidth = 3
        CurrentXY(1) = FactPXY(i, 1) - x0
        CurrentXY(2) = FactPXY(i, 2) - y0
        FactPXY(i, 1) = CurrentXY(1) * Cosδθ - CurrentXY(2) * sinδθ + x0
        FactPXY(i, 2) = CurrentXY(1) * sinδθ + CurrentXY(2) * Cosδθ + y0
        If i = 0 Then
            Picture1.PSet (FactPXY(i, 1), FactPXY(i, 2))
        Else
            Picture1.Line (FactPXY(i - 1, 1), FactPXY(i - 1, 2))-(FactPXY(i, 1), FactPXY(i, 2)), &H80FF&
        End If
    Next
     
   
    
     
    '画从动件
    δ = δ + δθ
    lin从动件.Y1 = PointXY(δ, 2) + L
    lin从动件.Y2 = PointXY(δ, 2)
    lin从动件.X1 = PointXY(δ, 1)
    lin从动件.X2 = PointXY(δ, 1)
    '滚子
    If r1 <> 0 Then
        Picture1.Circle (lin从动件.X2, lin从动件.Y2), r1, &HFFFF&
        Picture1.Circle (lin从动件.X2, lin从动件.Y2), r1, &HFFFF&
        Picture1.Circle (lin从动件.X2, lin从动件.Y2), 5, &HFFFF00
    End If
    
     
      '画位移线图
      
      For i = 1 To 360
        If i = 1 Then Picture1.PSet (O(1), O(2)), &HFF& '
        Picture1.DrawWidth = 3
        Picture1.Line -(XY(i, 1), XY(i, 2)), &HFF&
        Picture1.DrawWidth = 1
      Next
      
      Select Case δ
        Case δ0
            Picture1.Line (lin从动件.X2, lin从动件.Y2)-(XY(δ, 1), XY(δ, 2)), &HFF00FF
            Timer1.Enabled = False
            Line1.Visible = True: Line2.Visible = True
            Label1.Visible = True
            Lineh1.Visible = True
            Lineh2.Visible = True
            lab_h.Visible = True
            cmd继续.Caption = "继续"
        Case (δ0 + δ1)
            Picture1.Line (lin从动件.X2, lin从动件.Y2)-(XY(δ, 1), XY(δ, 2)), &HFF00FF
            Timer1.Enabled = False
            Line3.Visible = True
            Label2.Visible = True
            cmd继续.Caption = "继续"
        Case (δ0 + δ1 + δ2)
            Picture1.Line (lin从动件.X2, lin从动件.Y2)-(XY(δ, 1), XY(δ, 2)), &HFF00FF
            Timer1.Enabled = False
            Line4.Visible = True
            Label3.Visible = True
            cmd继续.Caption = "继续"
        Case 360
            Picture1.Line (lin从动件.X2, lin从动件.Y2)-(XY(0, 1), XY(0, 2)), &HFF00FF
            Timer1.Enabled = False
            Line5.Visible = True
            Label4.Visible = True
            δ = 0
            cmd继续.Caption = "动画演示"
     End Select
End Sub


Private Sub Timer2_Timer()
    
    If ii < i等分DT0 Then
        ii = ii + 1
        lin等分DT0(ii).BorderColor = &HFFFF&
        lin等分DT0(ii).BorderWidth = 2
        
        lin凸轮DT0(ii).BorderColor = &HFFFF&
        lin凸轮DT0(ii).BorderWidth = 2
        lin凸轮DT0(ii).Visible = True
        Timer2.Enabled = False
    End If
    
    
    
    If ii = i等分DT0 And jj < i等分DT2 Then
        jj = jj + 1
        lin等分DT2(jj).BorderColor = &HFFFF&
        lin等分DT2(jj).BorderWidth = 2
        lin凸轮DT2(jj).BorderColor = &HFFFF&
        lin凸轮DT2(jj).BorderWidth = 2
        lin凸轮DT2(jj).Visible = True
        Timer2.Enabled = False
    End If
    If jj = i等分DT2 Then
    
    End If
End Sub

Private Sub Timer3_Timer()
    
     δ = δ + 1
     If δ = 1 Then Picture1.Line (PointXY(0, 1), PointXY(0, 2))-(PointXY(δ, 1), PointXY(δ, 2)), &H80FF&
     Picture1.Line -(PointXY(δ, 1), PointXY(δ, 2)), &H80FF&
     
     If δ = 360 Then
        Timer3.Enabled = False
        frm对心设计.Enabled = True
        frm偏置设计.Enabled = True
        cmd设置.Enabled = True
        cmdReset.Enabled = True
        cmd继续.Enabled = True
        cmd设计.Enabled = True
        δ = 0
    End If
End Sub


Public Sub init1()
    Dim i As Integer
    Picture1.Cls
    ii = 0: jj = 0
    δ = 0
    Line1.Visible = False
    Line2.Visible = False
    Line3.Visible = False
    Line4.Visible = False
    Line5.Visible = False
    Lineh1.Visible = False
    Lineh2.Visible = False
    Label1.Visible = False
    Label2.Visible = False
    Label3.Visible = False
    Label4.Visible = False
    lab_h.Visible = False
    Timer1.Enabled = False
    Timer2.Enabled = False
    Timer3.Enabled = False
    
    If i等分DT0 <> 0 Then
        For i = 1 To i等分DT0
            Unload lin凸轮DT0(i)
            Unload lin基圆DT0(i)
            Unload lin等分DT0(i)
        Next
    End If
    i等分DT0 = 0
    If i等分DT2 <> 0 Then
        For i = 1 To i等分DT2
            Unload lin凸轮DT2(i)
            Unload lin基圆DT2(i)
            Unload lin等分DT2(i)
        Next
    End If
    i等分DT2 = 0
    sinδθ = Sin(δθ * PI / 180)
    Cosδθ = Cos(δθ * PI / 180)
    Picture1.Cls
    '画回转中心
    Picture1.DrawWidth = 1
    x0 = 230: y0 = 300
    Picture1.Circle (x0, y0), 10, &HFFFF&
     
     '画基圆
    Picture1.Circle (x0, y0), r0, &HFF&
    
    '画凸轮
    Call 计算凸轮轮廓上点
    Picture1.DrawWidth = 1
    For i = 0 To 360
        Picture1.Line -(PointXY(i, 1), PointXY(i, 2)), &H80FF&
    Next
    Picture1.DrawWidth = 3
    For i = 0 To 360
        Picture1.Line -(FactPXY(i, 1), FactPXY(i, 2)), &H80FF&
    Next
    'Picture1.DrawWidth = 1
    
      
    '画从动件
    lin从动件.Y1 = PointXY(0, 2) + L
    lin从动件.Y2 = PointXY(0, 2)
    lin从动件.X1 = PointXY(0, 1)
    lin从动件.X2 = PointXY(0, 1)
    
    Shape1.Left = lin从动件.X1 - 35
    Shape2.Left = lin从动件.X1 + 10
    'Picture1.FillStyle = 0
    'Picture1.FillColor = &HFFFF&
    If r1 <> 0 Then
        Picture1.Circle (lin从动件.X2, lin从动件.Y2), r1, &HFFFF&
        Picture1.Circle (lin从动件.X2, lin从动件.Y2), r1, &HFFFF&
        Picture1.Circle (lin从动件.X2, lin从动件.Y2), 5, &HFFFF00
    End If
      '画坐标轴
    linX.Y1 = PointXY(0, 2):  linX.Y2 = PointXY(0, 2)
    linY.Y1 = PointXY(0, 2): linY.Y2 = PointXY(0, 2) + 200
    'O(1) = linX.X1: O(2) = linX.Y1
    Label0.Top = O(2) - 10
    lab_t.Top = O(2) + 30
    
     
    For i = 0 To 360
        Picture1.DrawWidth = 3
        If i = 0 Then Picture1.PSet (O(1), O(2)), &HFF& '
        Picture1.Line -(XY(i, 1), XY(i, 2)), &HFF&
        'Picture1.DrawWidth = 1
    Next
    
    
    Line1.X1 = O(1): Line1.Y1 = O(2)
    Line1.X2 = O(1): Line1.Y2 = O(2) - 40
    
    Line2.X1 = XY(δ0, 1): Line2.Y1 = XY(δ0, 2)
    Line2.X2 = XY(δ0, 1): Line2.Y2 = O(2) - 40
    Label1.Top = O(2) - 10
    Label1.Left = (Line1.X2 + Line2.X2) / 2 - 20
    
    Line3.X1 = XY(δ0 + δ1, 1): Line3.Y1 = XY(δ0 + δ1, 2)
    Line3.X2 = XY(δ0 + δ1, 1): Line3.Y2 = O(2) - 40
    Label2.Top = O(2) - 10
    Label2.Left = (Line2.X2 + Line3.X2) / 2 - 20
    
    Line4.X1 = XY(δ0 + δ1 + δ2, 1): Line4.Y1 = XY(δ0 + δ1 + δ2, 2)
    Line4.X2 = XY(δ0 + δ1 + δ2, 1): Line4.Y2 = O(2) - 40
    Label3.Top = O(2) - 10
    Label3.Left = (Line3.X2 + Line4.X2) / 2 - 20
    
    Line5.X1 = XY(360, 1): Line5.Y1 = XY(360, 2)
    Line5.X2 = XY(360, 1): Line5.Y2 = O(2) - 40
    Label4.Top = O(2) - 10
    Label4.Left = (Line4.X2 + Line5.X2) / 2 - 20
    lab_h.Left = O(1) - 20: lab_h.Top = (O(2) + XY(δ0, 2)) / 2 + 10
    Lineh1.X1 = O(1) - 30: Lineh1.Y1 = XY(δ0, 2)
    Lineh1.X2 = XY(δ0, 1): Lineh1.Y2 = XY(δ0, 2)
    Lineh2.X1 = O(1) - 30: Lineh2.Y1 = O(2)
    Lineh2.X2 = O(1): Lineh2.Y2 = O(2)
End Sub