modcnc.bas

老外用VB写的CNC仿真程序源码

Attribute VB_Name = "ModCNC"
Option Explicit
Public ToX%, ToZ%, GCode%, FromX%, FromZ%
Public FeedRate%, IVal%, KVal%, PVal%, QVal%, RVal%, TVal%, SVal%, UVal%, WVal%
Public RFound As Boolean

' Process each line and break up into constituent blocks
Public Sub Process(str As String)
    Dim s As Variant, i As Integer
    
    'search for T, S
    If InStr(str, "T") Or InStr(str, "S") Then
        s = Split(str)
        For i = 0 To UBound(s)
            If UCase(Left(Trim$(s(i)), 1)) = "T" Then
                TVal = CInt(Right(s(i), Len(s(i)) - 1))
            ElseIf UCase(Left(Trim$(s(i)), 1)) = "S" Then
                SVal = CInt(Right(s(i), Len(s(i)) - 1))
            End If
        Next i
    End If
    
    s = Split(str)
    ' examine each block
    For i = 0 To UBound(s)
        Examine Trim$(s(i))
        
    Next i
    'now the appropriate G code
    RunGCode
End Sub

' Examine each string i.e. whether it is G, X, Z etc.
Public Sub Examine(ByVal str As String)
    Select Case Left(str, 1) ' left most character converted to uppercase
        Case "[":   'comment
        Case "F":
           FeedRate = CInt(Right(str, Len(str) - 1))
           frmMain.StatusBar.Panels("FeedRate").Text = "Feed: " & FeedRate
        Case "G":
            ProcessG str
        Case "I":
            IVal = CInt(Right(str, Len(str) - 1) * 10)
        Case "K":
            KVal = CInt(Right(str, Len(str) - 1) * 10)
        Case "N":
            'do nothing
        Case "P":
            PVal = CInt(Right(str, Len(str) - 1) * 10)
        Case "Q":
            QVal = CInt(Right(str, Len(str) - 1) * 10)
        Case "R":
            RVal = CInt(Right(str, Len(str) - 1) * 10) ' set radius
            RFound = True
        Case "M":
            ProcessMCode str
        Case "T":
            TVal = CInt(Right(str, Len(str) - 1))
        Case "X":
            ToX = CInt(((Right(str, Len(str) - 1)) / 2) * 10) ' set new end point
        Case "Z":
            ToZ = CInt(Right(str, Len(str) - 1) * 10) ' set new end point
        Case "U":
            UVal = CInt(((Right(str, Len(str) - 1) / 2)) * 10)
            ToX = FromX + UVal
        Case "W":
            WVal = CInt(((Right(str, Len(str) - 1) / 2)) * 10)
            ToZ = FromZ + WVal
    End Select
End Sub


' Process G codes
Public Sub ProcessG(ByVal str As String)
    Dim GVal As Integer
    GVal = CInt(Right(str, Len(str) - 1))   ' value of G code
    Select Case GVal
        Case 0:
            GCode = 0
        Case 1:
            GCode = 1
        Case 2:
            GCode = 2
        Case 3:
            GCode = 3
        Case 4:
            GCode = 4
        Case 20:
            frmMain.StatusBar.Panels("Dim").Text = "In"
        Case 21:
            frmMain.StatusBar.Panels("Dim").Text = "mm"
        Case 28:
            GCode = 28
        Case 70:
            GCode = 70
        Case 73:
            GCode = 73
        Case 90:
            GCode = 90
        Case 94:
            GCode = 94
        Case 97, 98:
            GCode = -1
        Case Else
            GCode = -1
    End Select
End Sub

Public Sub ProcessMCode(ByVal str As String)
    Dim MVal As Integer
    MVal = CInt(Right(str, Len(str) - 1))   ' value of M code
    Select Case MVal
        Case 0:
            'program stop
            frmInfo.lblInfo.Caption = "Program Stop"
            Call DisplayInfoForm(0, 2000)
            
            Call frmMain.mnuRunPause_Click
        Case 2:
            'program end
            frmInfo.lblInfo.Caption = "Program End"
            Call DisplayInfoForm(0, 2000)
            
            Call frmMain.mnuRunStop_Click
        Case 3:
            'spindle start CW
            frmInfo.lblInfo.Caption = "Spindle Start CW"
            Call DisplayInfoForm(0, 2000)
            frmMain.StatusBar.Panels("SpindleSpeed").Text = "S " & SVal
            frmMain.StatusBar.Panels("SpindleDirection").Text = "CW"
        Case 4:
            'spindle start CCW
            frmInfo.lblInfo.Caption = "Spindle Start CCW"
            Call DisplayInfoForm(0, 2000)
            frmMain.StatusBar.Panels("SpindleSpeed").Text = "S " & SVal
            frmMain.StatusBar.Panels("SpindleDirection").Text = "CCW"
        Case 5:
            'spindle stop
            frmInfo.lblInfo.Caption = "Spindle Stop"
            Call DisplayInfoForm(0, 2000)
            SVal = 0
            frmMain.StatusBar.Panels("SpindleSpeed").Text = "S " & SVal
            frmMain.StatusBar.Panels("SpindleDirection").Text = ""
        Case 6:
            'tool change
            frmInfo.lblInfo.Caption = "Tool " & TVal & " loaded"
            Call DisplayInfoForm(0, 2000)
            
            Call frmToolSelect.GetToolList
            Dim LocalToolWidth%, LocalToolHeight%
            Call GetToolInfo(App.path & "\tools\" & ToolListArray(TVal), LocalToolHeight, LocalToolWidth)
            Call DeleteToolMemory
            Call SetToolMemory(App.path & "\tools\" & ToolListArray(TVal), LocalToolWidth, LocalToolHeight)
        
        Case 8:
            'coolant on
            frmMain.StatusBar.Panels("Coolant").Text = "Coolant: ON"
            frmInfo.lblInfo.Caption = "Coolant: ON"
            Call DisplayInfoForm(0, 2000)
        Case 9:
            'coolant off
            frmMain.StatusBar.Panels("Coolant").Text = "Coolant: OFF"
            frmInfo.lblInfo.Caption = "Coolant: OFF"
            Call DisplayInfoForm(0, 2000)
            
        Case 10:
            'chuck open
            frmInfo.lblInfo.Caption = "Chuck OPEN"
            Call DisplayInfoForm(1, 500)
            
        Case 11:
            'chuck close
            frmInfo.lblInfo.Caption = "Chuck CLOSE"
            Call DisplayInfoForm(1, 500)
            
        Case 13:
        'coolant on, spindle start CW
            frmMain.StatusBar.Panels("SpindleSpeed").Text = "S " & SVal
            frmMain.StatusBar.Panels("SpindleDirection").Text = "CW"
            frmMain.StatusBar.Panels("Coolant").Text = "Coolant: ON"
            frmInfo.lblInfo.Caption = "Spindle Start CW, Coolant ON"
            Call DisplayInfoForm(0, 2000)
            
        Case 14:
        'coolant on, spindle start CCW
            frmMain.StatusBar.Panels("SpindleSpeed").Text = "S " & SVal
            frmMain.StatusBar.Panels("SpindleDirection").Text = "CCW"
            frmMain.StatusBar.Panels("Coolant").Text = "Coolant: ON"
            frmInfo.lblInfo.Caption = "Spindle Start CCW, Coolant ON"
            Call DisplayInfoForm(0, 2000)
        
        Case 25:
            'quill extend
            frmInfo.lblInfo.Caption = "Quill Extend"
            Call DisplayInfoForm(0, 2000)
            
        Case 26:
            'quill retract
            frmInfo.lblInfo.Caption = "Quill Retract"
            Call DisplayInfoForm(0, 2000)
            
        Case 30:
            'program end, coolant off, spindle stop
            frmMain.StatusBar.Panels("Coolant").Text = "Coolant: OFF"
            frmInfo.lblInfo.Caption = "Spindle Stop"
            Call frmMain.mnuRunStop_Click
            frmInfo.lblInfo.Caption = "Program end and reset"
            Call DisplayInfoForm(0, 2000)
           
        Case 38:
            'door open
            frmInfo.lblInfo.Caption = "Door OPEN"
            Call DisplayInfoForm(1, 500)
            
        Case 39:
            'door close
            frmInfo.lblInfo.Caption = "Door CLOSE"
            Call DisplayInfoForm(1, 500)
    End Select
End Sub

Public Sub RunGCode()
    Select Case GCode
        Case -1:    'invalid G code
            'MsgBox "No appropriate G code value has been defined!", vbCritical, "Error"
        Case 0: 'G00
            ExecuteG00
        Case 1:
            ExecuteG01
        Case 2:
            ExecuteG02
        Case 3:
            ExecuteG03
        Case 4:
           ' ExecuteG04
        Case 28:
            ExecuteG28
        Case 70:
            'ExecuteG70
        Case 73:
            ExecuteG73
        Case 90:
            ExecuteG90
        Case 94:
            ExecuteG94
        Case Else:  'invalid G code
            'MsgBox "No appropriate G code value has been defined!", vbCritical, "Error"
    End Select
End Sub

'get tool width and tool height
Private Sub GetToolInfo(ByVal path As String, ByRef LocalToolHeight%, ByRef LocalToolWidth%)
    Dim fNum, i As Integer
    Dim txt As String
    Dim Var
    fNum = FreeFile
    Dim fName As String
    fName = Left(path, Len(path) - 3) & "ini"
    Open fName For Input As #fNum
    Do While Not EOF(fNum)
        Line Input #fNum, txt
        If Not txt = "" Then
           Var = Split(txt, "=")
           Select Case UCase(Var(0))
            Case "TOOLWIDTH":
                LocalToolWidth = Trim(Var(1))
            Case "TOOLHEIGHT":
                LocalToolHeight = Trim(Var(1))
            'Case "CUTTINGPOINT":
             '   lblCuttingPoint.Caption = Trim(Var(1))
            End Select
        End If
    Loop
End Sub