mdlmain.bas

共轭凸轮绘制及运动仿真程序。输入共轭凸轮参数后可以绘制凸轮并进行仿真。

Attribute VB_Name = "mdlMain"
Option Explicit
Option Base 1

Public s(1 To 360) As Double
Public tmpS() As Double

Public h As Double              '最大推程
Public base As Double           '基圆大小

Public tcA As Integer           '推程角
Public yxA As Integer           '远休止角
Public hcA As Integer           '回程角
Public jxA As Integer           '近休止角

Public LoopCount As Integer     '开口循环数

Public motionTypeTC As Integer  '推程段运动规律
Public motionTypeHC As Integer  '回程段运动规律

Public Const Pi As Double = 3.1415926536

'------------------参数初始化-------------------------------------------------
Sub init()
    
    h = 30
    base = 80
    
    tcA = 200
    yxA = 40
    hcA = 120
    jxA = 0
    
    LoopCount = 1
    
    motionTypeTC = 1
    motionTypeHC = 1
    
    If LoopCount * (tcA + yxA + hcA + jxA) <> 360 Then
        MsgBox "参数错误，不能构成整圆！"
    End If
    
End Sub

'-------------------计算凸轮数据-----------------------------------------------------------
Sub CalPar(ByVal n As Long)
    
    Dim i As Long
    Dim j As Long
    Dim k As Long
    
    Dim t As Long
       
    For i = 1 To n
        
        t = (360 / n) * (i - 1)
        
        '推程段
        calTc
        For j = 1 + t To tcA + t
            s(j) = tmpS(j - (1 + t) + 1)
        Next
        
        '远休止段
        calYx
        For j = 1 + tcA + t To yxA + tcA + t
            s(j) = tmpS(j - (1 + tcA + t) + 1)
        Next
        
        '回程段
        calHc
        For j = 1 + yxA + tcA + t To hcA + yxA + tcA + t
            s(j) = tmpS(j - (1 + yxA + tcA + t) + 1)
        Next
        
        '近休止段
        calJx
        For j = 1 + hcA + yxA + tcA + t To jxA + hcA + yxA + tcA + t
            s(j) = tmpS(j - (1 + hcA + yxA + tcA + t) + 1)
        Next
        
    Next
        
End Sub

'-------------------计算推程段数据，用motionTypeTC判断所需运动规律---------------------------------
Function calTc()
    
    If tcA = 0 Then Exit Function
    
    Select Case motionTypeTC
    Case 0
        motionTest tcA
    Case 1
        motionSX tcA
    Case Else
        motionTest tcA
    End Select

    
End Function

'-------------------计算远休止程段数据-----------------------------------------------------------
Function calYx()

    If yxA = 0 Then Exit Function

    Dim i As Long
    ReDim tmpS(1 To yxA)
    
    For i = 1 To yxA
        tmpS(i) = h
    Next

End Function

'-------------------计算回程段数据，用motionTypeTC判断所需运动规律---------------------------------
Function calHc()

    If hcA = 0 Then Exit Function
    
    Dim tmp() As Double
    ReDim tmp(1 To hcA)
    Dim i As Long
    
    
    Select Case motionTypeHC
    Case 0
        motionTest hcA
    Case 1
        motionSX hcA
    Case Else
        motionTest hcA
    End Select
    
    For i = 1 To hcA
        tmp(i) = tmpS(i)
    Next

    For i = 1 To hcA
        tmpS(hcA - i + 1) = tmp(i)
    Next

End Function

'-------------------计算近休止程段数据-----------------------------------------------------------
Function calJx()

    If jxA = 0 Then Exit Function
    
    Dim i As Long
    ReDim tmpS(1 To jxA)
    
    For i = 1 To jxA
        tmpS(i) = 0
    Next

End Function