frmmain.frm

一个不错的数控源码是vb的

    NCCSwitch = 0
cmdNCC.Caption = "遥杆开"
cmdNCC.BackColor = &H808080
Else
    NCCSwitch = 1
cmdNCC.Caption = "遥杆关"
cmdNCC.BackColor = &HFF00&

End If


End Sub

Private Sub cmdOpenLocate_Click()
    Frame1.Visible = True
End Sub

Private Sub cmdReturn_Click()
    Dim i As Long
    
    On Error Resume Next
    
    lblMsg.Caption = "正在回原点"
        
    For i = 0 To 2
        get_abs_pos i + 1, ProcessBeginPoint(i)
    Next i
    
    set_profile 1, 5000, 50000, 50000
    set_profile 2, 5000, 50000, 50000
    set_profile 3, 500, 1000, 700
       
    set_batch_flag 1
    fast_pmove2 1, -ProcessBeginPoint(0), 2, -ProcessBeginPoint(1)
    fast_pmove 3, -ProcessBeginPoint(2)
End Sub

Private Sub cmdSave_Click()
    Dim i As Long
    
    On Error Resume Next
    Dim Statics_File As String
    Statics_File = Date & ".txt"
    Open App.Path & "\" & Statics_File For Append As #2
        '*************************************
        '统计参数
        Print #2, ""
        Print #2, "┏━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━"
        Print #2, "┃截止     " & Now
        Print #2, "┠─────────────────────────────────"
        Print #2, "┃图纸     " & FilePath
        Print #2, "┠─────────────────────────────────"
        Print #2, "┃统计项目:"
        Print #2, "┠─────────────────────────────────"
        Print #2, "┃          加工数目         " & Processed
        Print #2, "┠─────────────────────────────────"
        Print #2, "┃          成品率           " & FinishRate & "%"
        Print #2, "┠─────────────────────────────────"
        Print #2, "┃          废品率           " & FailingRate & "%"
        Print #2, "┠─────────────────────────────────"
        Print #2, "┃          本次加工时间     " & AverageTime(0) & "小时" & AverageTime(1) & "分" & AverageTime(2) & "秒"
        Print #2, "┠─────────────────────────────────"
        Print #2, "┃          累计加工时间     " & AccumulationTime(0) & "小时" & AccumulationTime(1) & "分" & AccumulationTime(2) & "秒"
        Print #2, "┗━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━"
        Print #2, ""
    Close #2
    Exit Sub
End Sub

Private Sub Command1_Click()
    set_profile 1, FindPointSpeed(2, 0), FindPointSpeed(2, 1), FindPointSpeed(2, 2)
    set_profile 2, FindPointSpeed(2, 0), FindPointSpeed(2, 1), FindPointSpeed(2, 2)
    set_profile 3, UpdownMoveSpeed(2, 0), UpdownMoveSpeed(2, 1), UpdownMoveSpeed(2, 2)

            lblMsg.Caption = "右行 ..."
            fast_vmove 2, 1
    
End Sub

Private Sub Command2_Click()
            fast_vmove 2, -1

End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

    If KeyCode = 17 Then
        set_debug_flag 1
    End If

    Select Case KeyCode
    Case 33:
        simpleMove 0
    Case 34:
        simpleMove 1
    Case 37:
        simpleMove 2
    Case 39:
        simpleMove 3
    Case 40:
        simpleMove 4
    Case 38:
        simpleMove 5

    Case 32:
    sudden_stop3 1, 2, 3
    lblMsg.Caption = "停止"
    End Select
End Sub
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    set_debug_flag 0
    On Error Resume Next

    'sudden_stop3 1, 2, 3
    'lblMsg.Caption = "停止"

    'MsgBox KeyCode
    Select Case KeyCode
    Case 33:
    decel_stop3 1, 2, 3
    lblMsg.Caption = "停止"
    Case 34:
    decel_stop3 1, 2, 3
    lblMsg.Caption = "停止"
    Case 37:
    decel_stop3 1, 2, 3
    lblMsg.Caption = "停止"
    Case 38:
    decel_stop3 1, 2, 3
   lblMsg.Caption = "停止"
    Case 39:
   decel_stop3 1, 2, 3
    lblMsg.Caption = "停止"
   Case 40:
    decel_stop3 1, 2, 3
    lblMsg.Caption = "停止"
    Case 35:
    cmdLocated_Click

    Case 88:
    lblFilePath_Click
    Case 67:
    If tabProcess.Tab = 1 Then
   tabProcess.Tab = 0
   Else
   tabProcess.Tab = 1
    End If
    Case 86:
    cmdNCC_Click
    Case 66:
    cmdConfig_Click
    Case 78:
    cmdOpenLocate_Click
    Case 77:
cmdStartProcess_Click
Case 188:
cmdPause_Click
    Case 190:
    cmdSuddenStop_Click
    Case 191:
    cmdReturn_Click

    End Select
   
End Sub
Private Sub lblFilePath_Click()
    lblMsg.Caption = "打开一个待加工文件 ..."
    OpenFileToProcess
End Sub

Private Sub cmdPause_Click()
    Dim i As Long
    On Error Resume Next
    
    decel_stop3 1, 2, 3
End Sub

Private Sub cmdSimpleMove_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    On Error Resume Next
    
    set_profile 1, AdjustSpeed(0, 0), AdjustSpeed(0, 1), AdjustSpeed(0, 2)
    set_profile 2, AdjustSpeed(1, 0), AdjustSpeed(1, 1), AdjustSpeed(1, 2)
    set_profile 3, AdjustSpeed(2, 0), AdjustSpeed(2, 1), AdjustSpeed(2, 2)

    Select Case Index
        Case 0
            lblMsg.Caption = "上行 ..."
            fast_vmove 3, -1
        Case 1
            lblMsg.Caption = "下行 ..."
            fast_vmove 3, 1
        Case 2
            lblMsg.Caption = "左行 ..."
            fast_vmove 2, -1
        Case 3
            lblMsg.Caption = "右行 ..."
            fast_vmove 2, 1
        Case 4
            lblMsg.Caption = "前行 ..."
            
            fast_vmove 1, -1
        Case 5
            lblMsg.Caption = "后行 ..."
            fast_vmove 1, 1
    End Select
End Sub

Private Sub simpleMove(Index As Integer)
    On Error Resume Next
    
    set_profile 1, FindPointSpeed(2, 0), FindPointSpeed(2, 1), FindPointSpeed(2, 2)
    set_profile 2, FindPointSpeed(2, 0), FindPointSpeed(2, 1), FindPointSpeed(2, 2)
    set_profile 3, UpdownMoveSpeed(2, 0), UpdownMoveSpeed(2, 1), UpdownMoveSpeed(2, 2)

    Select Case Index
        Case 0
            lblMsg.Caption = "上行 ..."
            fast_vmove 3, -1
        Case 1
            lblMsg.Caption = "下行 ..."
            fast_vmove 3, 1
        Case 2
            lblMsg.Caption = "左行 ..."
            fast_vmove 2, -1
        Case 3
            lblMsg.Caption = "右行 ..."
            fast_vmove 2, 1
        Case 4
            lblMsg.Caption = "前行 ..."
            fast_vmove 1, -1
        Case 5
            lblMsg.Caption = "后行 ..."
            fast_vmove 1, 1
    End Select
    
End Sub

Private Sub cmdSimpleMove_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    On Error Resume Next
    
    decel_stop3 1, 2, 3
    lblMsg.Caption = "停止"
End Sub
'#########################################################################
'根据设置启动批指令运动
Private Sub cmdStartProcess_Click()
    Dim a1 As Long
    Dim a2 As Long
    
    On Error Resume Next
    
    If lblFilePath.Caption = "" Then
        MsgBox ("您必须先选择一个加工文件")
        Exit Sub
    End If
    
    If Right$(lblFilePath.Caption, 3) = "dxf" Then
        GetFrameProcessingParam
        
        If debugFlag = 0 Then

            If frmAnalyse.AnalyseDXFFile() = 0 Then
                frmAnalyse.Show
                Exit Sub
            End If
        Else
            frmAnalyse.AnalyseDXFFile
            frmAnalyse.Show
            set_debug_flag 0
            Exit Sub
        End If
    Else
        If debugFlag = 0 Then

            If frmExecuteG.AnalyseCutFile() = 0 Then
                frmExecuteG.Show
                Exit Sub
            End If
        Else
            frmExecuteG.AnalyseCutFile
            frmExecuteG.Show
            set_debug_flag 0
            Exit Sub
        End If
    End If
            
    ClearGraphic
        
    set_batch_flag 1
          
    lblMsg.Caption = "正在加工..."
        
    set_servo_on 1, 0
    set_servo_on 2, 0
    set_servo_on 3, 0
    
    executeInstructionSquence
End Sub

Private Sub set_debug_flag(f As Long)
    If f = 0 Then
        debugFlag = 0
    End If
    If f = 1 Then
        debugFlag = 1
    End If
End Sub

Private Function executeInstructionSquence() As Long
    Dim i As Long
    Dim word() As String
    Dim tempWord() As String
    Dim j As Long
    Dim mInstrCount As Long
    
    Dim v As Long
    
    For i = 0 To 2
        pFactor(i) = ProcessFactor(processFactorSelect, i)
    Next i
    
    'ProcessFactor(0, 0) = 994  软
    'ProcessFactor(0, 1) = 1002
    
    'ProcessFactor(0, 0) = 995  硬
    'ProcessFactor(0, 1) = 1004
    
    'ProcessFactor(0, 2) = 79
    
    set_batch_flag (1)
    
    For i = 1 To LINE_MAX_AXES_NUM + 1
        reset_pos i
    Next i

    For i = LBound(instructionSquence) To UBound(instructionSquence)
    
        word = Split(instructionSquence(i))
        Select Case word(0)
        Case "fast_pmove"
            set_velocity word()
            step = CLng(Val(word(2)) * pFactor(2))
            fast_pmove ch3, step
        Case "find_fast_line2"
            set_velocity word()
            pos1 = CLng(Val(word(2)) * pFactor(0))
            pos2 = CLng(Val(word(4)) * pFactor(1))
            fast_line2 ch2, pos1, ch1, pos2
        Case "cut_fast_line2"
            set_velocity word()
            pos1 = CLng(Val(word(2)) * pFactor(0))
            pos2 = CLng(Val(word(4)) * pFactor(1))
            fast_line2 ch2, pos1, ch1, pos2
        Case "cut_fast_arc_center"
            set_velocity word()
            center1 = CLng(Val(word(3)) * pFactor(0))
            center2 = CLng(Val(word(4)) * pFactor(1))
            angle = Val(word(5))
            fast_arc_center ch2, ch1, center1, center2, angle
        Case "wash_fast_line2"
            set_velocity word()
            pos1 = CLng(Val(word(2)) * pFactor(0))
            pos2 = CLng(Val(word(4)) * pFactor(1))
            fast_line2 ch2, pos1, ch1, pos2
        Case Else
            MsgBox "请检查代码生成部分代码"
            End
        End Select
    Next i

    cmdLocated.Enabled = True
    cmdLocated.Caption = "原点确定"
    processFlag = True
End Function

Private Function set_velocity(word() As String) As Lo