frmexecuteg.frm

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

VERSION 5.00
Begin VB.Form frmExecuteG 
   Caption         =   "分析待加工文件"
   ClientHeight    =   4335
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5925
   Icon            =   "frmExecuteG.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   4335
   ScaleWidth      =   5925
   StartUpPosition =   2  '屏幕中心
   Begin VB.Frame Frame1 
      Caption         =   "分析信息"
      Height          =   3495
      Left            =   120
      TabIndex        =   1
      Top             =   120
      Width           =   5655
      Begin VB.ListBox lstMsg 
         Height          =   3105
         IntegralHeight  =   0   'False
         Left            =   120
         TabIndex        =   2
         Top             =   240
         Width           =   5415
      End
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "确 定"
      Height          =   375
      Left            =   4680
      TabIndex        =   0
      Top             =   3840
      Width           =   975
   End
End
Attribute VB_Name = "frmExecuteG"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
 
Dim CUTFileArray() As String

Private arrayCount As Long

Private Type GCode    'G代码
    GAxe As String              '坐标名称
    GVal As String              '对应的值
End Type

Dim AnalyseFlag As Boolean

Const ch1 = 1
Const ch2 = 2
Const ch3 = 3
Dim step As Long
Dim pos1 As Double
Dim pos2 As Double
Dim center1 As Double
Dim center2 As Double
Dim angle As Double

Dim errMsg As String

Public Function AnalyseCutFile() As Long
    arrayCount = 0
    
    If readCUTFileToCUTFileArray = -1 Then
        lstMsg.AddItem ("分析失败。")
        lstMsg.AddItem (errMsg)
        AnalyseCutFile = 0
        Exit Function
    End If
    
    If readCutArrayToInstructionSquence = -1 Then
        lstMsg.AddItem ("分析失败。")
        lstMsg.AddItem (errMsg)
        AnalyseCutFile = 0
        Exit Function
    End If
    
    If readInstructionSquenceToList = -1 Then
        lstMsg.AddItem ("分析失败。")
        lstMsg.AddItem (errMsg)
        AnalyseCutFile = 0
        Exit Function
    End If

    lstMsg.AddItem ("分析成功。")
    lstMsg.AddItem ("请检查配置选项，确认后开始加工")
    
    AnalyseCutFile = 1
End Function
'#############################################################################
'把G代码文件的内容读到G代码文件数组DXFFileArray中
Private Function readCUTFileToCUTFileArray() As Long
    
    Dim LineNumber As Long
    Dim str As String
    
    On Error GoTo rDFTDAEerrHandle

    Open frmMain.lblFilePath.Caption For Input As #1

    LineNumber = 0
    
    While Not EOF(1)
    
        Line Input #1, str
                
        ReDim Preserve CUTFileArray(LineNumber)
        CUTFileArray(LineNumber) = str
        
        LineNumber = LineNumber + 1
        
    Wend
    
    Close 1
    
    readCUTFileToCUTFileArray = 0
    Exit Function
rDFTDAEerrHandle:
    errMsg = "请检查该文件是否存在。"
    readCUTFileToCUTFileArray = -1
End Function
'#############################################################################
'读G代码文件数组到指令序列
Private Function readCutArrayToInstructionSquence() As Long
    Dim i As Long
    Dim j As Long
    
    Dim dis1 As Long
    Dim dis2 As Long
    Dim dis3 As Long
    
    Dim dis As Long
    
    Dim lastG As String
    lastG = "G00"
    
    '在所有的批令前手工加入安全高度
    step = SpaceHight
    addToArray "fast_pmove " & ch3 & " " & -step & " ", instructionSquence()
    
    For i = 3 To UBound(CUTFileArray) - 1
        '找X,Y,Z
        dis1 = InStr(1, CUTFileArray(i), "X", 0)
        dis2 = InStr(1, CUTFileArray(i), "Y", 0)
        dis3 = InStr(1, CUTFileArray(i), "Z", 0)
        
        '如果找到
        If (dis1 + dis2 + dis3) <> 0 Then

            '查找关键字
            dis = InStr(1, CUTFileArray(i), "G00", 0)
             If dis <> 0 Then
                If dealG00(CUTFileArray(i)) = -1 Then
                    readCutArrayToInstructionSquence = -1
                    Exit Function
                End If
                lastG = "G00"
                GoTo ExitIf
            End If
            
            dis = InStr(1, CUTFileArray(i), "G01", 0)
            If dis <> 0 Then
                If dealG01(CUTFileArray(i)) = -1 Then
                    readCutArrayToInstructionSquence = -1
                    Exit Function
                End If
                lastG = "G01"
                GoTo ExitIf
            End If
            
            dis = InStr(1, CUTFileArray(i), "G02", 0)
            If dis <> 0 Then
                If dealG02(CUTFileArray(i)) = -1 Then
                    readCutArrayToInstructionSquence = -1
                    Exit Function
                End If
                lastG = "G02"
                GoTo ExitIf
            End If
            
            dis = InStr(1, CUTFileArray(i), "G03", 0)
            If dis <> 0 Then
                If dealG03(CUTFileArray(i)) = -1 Then
                    readCutArrayToInstructionSquence = -1
                    Exit Function
                End If
                lastG = "G03"
                GoTo ExitIf
            End If
            
            '如果没找到关键字
            If dis = 0 Then
                Select Case lastG
                Case "G00":
                If dealG00(CUTFileArray(i)) = -1 Then
                    readCutArrayToInstructionSquence = -1
                    Exit Function
                End If

                Case "G01":
                If dealG01(CUTFileArray(i)) = -1 Then
                    readCutArrayToInstructionSquence = -1
                    Exit Function
                End If

                Case "G02":
                If dealG02(CUTFileArray(i)) = -1 Then
                    readCutArrayToInstructionSquence = -1
                    Exit Function
                End If

                Case "G03":
                If dealG03(CUTFileArray(i)) = -1 Then
                    readCutArrayToInstructionSquence = -1
                    Exit Function
                End If

                End Select
            End If
            
        End If
ExitIf:
    Next i
    '手工添加指令，使电主轴后置，以便更换工件
    pos2 = BackSpace
    addToArray "find_fast_line2 " & ch1 & " " & 0 & " " & ch2 & " " & pos2 & " ", instructionSquence()
End Function
'#################################################
'处理G代码G00
Private Function dealG00(GCode As String) As Long
    Dim i As Long
    Dim j As Long
    
    Dim dis As Long
    Dim s As String
    
    Dim gWord() As GCode
    
    '查找"X"
    dis = InStr(1, GCode, "X", vbBinaryCompare)
    If dis <> 0 Then
        For i = 2 To Len(GCode)
            s = Mid$(GCode, dis + 1, i)
            If (Not IsNumeric(s)) Or (dis + i > Len(GCode)) Then
                ReDim Preserve gWord(j) As GCode
                gWord(j).GAxe = "X"
                gWord(j).GVal = Mid$(GCode, dis + 1, i - 1)
                j = j + 1
                Exit For
            End If
        Next i
    End If
    
    '查找"Y"
    dis = InStr(1, GCode, "Y", vbBinaryCompare)
    If dis <> 0 Then
        For i = 2 To Len(GCode)
            s = Mid$(GCode, dis + 1, i)
            If (Not IsNumeric(s)) Or (dis + i > Len(GCode)) Then
                ReDim Preserve gWord(j) As GCode
                gWord(j).GAxe = "Y"
                gWord(j).GVal = Mid$(GCode, dis + 1, i - 1)
                j = j + 1
                Exit For
            End If
        Next i
    End If
    
    '查找"Z"
    dis = InStr(1, GCode, "Z", vbBinaryCompare)
    If dis <> 0 Then
        For i = 2 To Len(GCode)
            s = Mid$(GCode, dis + 1, i)
            If (Not IsNumeric(s)) Or (dis + i > Len(GCode)) Then
                ReDim Preserve gWord(j) As GCode
                gWord(j).GAxe = "Z"
                gWord(j).GVal = Mid$(GCode, dis + 1, i - 1)
                j = j + 1
                Exit For
            End If
        Next i
    End If
    
    If UBound(gWord) = 1 Then
        pos1 = CDbl(gWord(0).GVal)
        pos2 = CDbl(gWord(1).GVal)
        addToArray "cut_fast_line2 " & ch1 & " " & pos1 & " " & ch2 & " " & pos2 & " ", instructionSquence()
    Else
        Select Case gWord(0).GAxe
        Case "X"
            pos1 = gWord(0).GVal
            addToArray "cut_fast_line2 " & ch1 & " " & pos1 & " " & ch2 & " " & 0 & " ", instructionSquence()
        Case "Y"
            pos2 = gWord(0).GVal
            addToArray "cut_fast_line2 " & ch1 & " " & 0 & " " & ch2 & " " & pos2 & " ", instructionSquence()
        Case "Z"
            step = gWord(0).GVal
            addToArray "fast_pmove " & ch3 & " " & -step & " ", instructionSquence()
        End Select
    End If
End Function
'#################################################
'处理G代码G01
Private Function dealG01(GCode As String) As Long
    Dim i As Long
    Dim j As Long
    
    Dim dis As Long
    Dim s As String
    
    Dim gWord() As GCode
            
    '查找"X"
    dis = InStr(1, GCode, "X", vbBinaryCompare)
    If dis <> 0 Then
        For i = 2 To Len(GCode)
            s = Mid$(GCode, dis + 1, i)
            If (Not IsNumeric(s)) Or (dis + i > Len(GCode)) Then
                ReDim Preserve gWord(j) As GCode
                gWord(j).GAxe = "X"
                gWord(j).GVal = Mid$(GCode, dis + 1, i - 1)
                j = j + 1
                Exit For
            End If
        Next i
    End If
    
    '查找"Y"
    dis = InStr(1, GCode, "Y", vbBinaryCompare)
    If dis <> 0 Then
        For i = 2 To Len(GCode)
            s = Mid$(GCode, dis + 1, i)
            If (Not IsNumeric(s)) Or (dis + i > Len(GCode)) Then
                ReDim Preserve gWord(j) As GCode
                gWord(j).GAxe = "Y"
                gWord(j).GVal = Mid$(GCode, dis + 1, i - 1)
                j = j + 1
                Exit For
            End If
        Next i
    End If
    
    '查找"Z"
    dis = InStr(1, GCode, "Z", vbBinaryCompare)
    If dis <> 0 Then
        For i = 2 To Len(GCode)
            s = Mid$(GCode, dis + 1, i)
            If (Not IsNumeric(s)) Or (dis + i > Len(GCode)) Then
                ReDim Preserve gWord(j) As GCode
                gWord(j).GAxe = "Z"
                gWord(j).GVal = Mid$(GCode, dis + 1, i - 1)
                j = j + 1
                Exit For
            End If
        Next i
    End If
    
    If UBound(gWord) = 1 Then
        pos1 = CDbl(gWord(0).GVal)
        pos2 = CDbl(gWord(1).GVal)
        addToArray "cut_fast_line2 " & ch1 & " " & pos1 & " " & ch2 & " " & pos2 & " ", instructionSquence()
    Else
        Select Case gWord(0).GAxe
        Case "X"
            pos1 = gWord(0).GVal
            addToArray "cut_fast_line2 " & ch1 & " " & pos1 & " " & ch2 & " " & 0 & " ", instructionSquence()
        Case "Y"
            pos2 = gWord(0).GVal
            addToArray "cut_fast_line2 " & ch1 & " " & 0 & " " & ch2 & " " & pos2 & " ", instructionSquence()
        Case "Z"
            step = gWord(0).GVal
            addToArray "fast_pmove " & ch3 & " " & -step & " ", instructionSquence()
        End Select
    End If
End Function
'#################################################
'处理G代码G02
Private Function dealG02(GCode As String) As Long
    Dim i As Long
    Dim j As Long
    
    Dim dis As Long
    Dim s As String