frmexecuteg.frm

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

    
    Dim t1 As Double
    Dim t2 As Double
    Dim t3 As Double
    Dim t4 As Double
    
    Dim v1 As Double
    Dim v2 As Double
    
    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
    
    '查找"I"
    dis = InStr(1, GCode, "I", 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 = "I"
                gWord(j).GVal = Mid$(GCode, dis + 1, i - 1)
                j = j + 1
                Exit For
            End If
        Next i
    End If

    '查找"J"
    dis = InStr(1, GCode, "J", 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 = "J"
                gWord(j).GVal = Mid$(GCode, dis + 1, i - 1)
                j = j + 1
                Exit For
            End If
        Next i
    End If
    
    t1 = CDbl(gWord(0).GVal)
    t2 = CDbl(gWord(1).GVal)
    t3 = CDbl(gWord(2).GVal)
    t4 = CDbl(gWord(3).GVal)
    
    v1 = (Sqr(t1 ^ 2 + t2 ^ 2)) / 2#
    v2 = t3 ^ 2 + t4 ^ 2 - v1 ^ 2
    If Abs(v2) - 0.01 > 0 And v2 < 0 Then
        dealG02 = -1
        errMsg = "请在CAM软件的后置设置中选择增量编程"
        MsgBox "1111111111111111111111111111111111"
        MsgBox t1 & "   " & t2 & "   " & t3 & "   " & t4
        MsgBox v1 & "     " & v2
        Exit Function
    End If
    
    angle = getAngleForG02(gWord())
    
    center1 = CDbl(gWord(2).GVal)
    center2 = CDbl(gWord(3).GVal)
    addToArray "cut_fast_arc_center " & ch1 & " " & ch2 & " " & center1 & " " & center2 & " " & angle & " ", instructionSquence()
End Function
'#################################################
'处理G代码G03
Private Function dealG03(GCode As String) As Long
    Dim i As Long
    Dim j As Long
    
    Dim dis As Long
    Dim s As String
    
    Dim t1 As Double
    Dim t2 As Double
    Dim t3 As Double
    Dim t4 As Double
    
    Dim v1 As Double
    Dim v2 As Double
    
    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
    
    '查找"I"
    dis = InStr(1, GCode, "I", 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 = "I"
                gWord(j).GVal = Mid$(GCode, dis + 1, i - 1)
                j = j + 1
                Exit For
            End If
        Next i
    End If

    '查找"J"
    dis = InStr(1, GCode, "J", 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 = "J"
                gWord(j).GVal = Mid$(GCode, dis + 1, i - 1)
                j = j + 1
                Exit For
            End If
        Next i
    End If
    
    t1 = CDbl(gWord(0).GVal)
    t2 = CDbl(gWord(1).GVal)
    t3 = CDbl(gWord(2).GVal)
    t4 = CDbl(gWord(3).GVal)
    
    v1 = (Sqr(t1 ^ 2 + t2 ^ 2)) / 2#
    v2 = t3 ^ 2 + t4 ^ 2 - v1 ^ 2
    If v2 > 0.01 And v2 < 0 Then
        dealG03 = -1
        errMsg = "请在CAM软件的后置设置中选择增量编程"
        MsgBox "jroewjqropwq"
        Exit Function
    End If
    
    angle = getAngleForG03(gWord())
    
    center1 = CDbl(gWord(2).GVal)
    center2 = CDbl(gWord(3).GVal)
    addToArray "cut_fast_arc_center " & ch1 & " " & ch2 & " " & center1 & " " & center2 & " " & angle & " ", instructionSquence()
End Function

Private Function getAngleForG02(g() As GCode) As Double
    Dim con1 As Boolean
    Dim con2 As Boolean
    Dim con3 As Boolean
    Dim con4 As Boolean
    
    Dim temp1 As Double
    Dim temp2 As Double

    Dim k As Double
    
    Dim X As Double
    Dim Y As Double
    Dim i As Double
    Dim j As Double
    
    X = CDbl(g(0).GVal)
    Y = CDbl(g(1).GVal)
    i = CDbl(g(2).GVal)
    j = CDbl(g(3).GVal)
    
    
    '360
    con1 = (X = 0) And (Y = 0)
    If con1 = True Then
        getAngleForG02 = 360#
        Exit Function
    End If
    
    If X <> 0 Then
        k = CDbl(Y / X)
    Else
        k = 1E+21
    End If
    
    '180
    con2 = ((X > 0) And (Y = 0) And (i > 0) And (j = 0)) _
        Or ((X = 0) And (Y > 0) And (i = 0) And (j > 0)) _
        Or ((X < 0) And (Y = 0) And (i < 0) And (j = 0)) _
        Or ((X = 0) And (Y < 0) And (i = 0) And (j < 0)) _
        Or ((X <> 0) And (Y <> 0) And (j - k * i = 0))
    If con2 = True Then
        getAngleForG02 = 180#
        Exit Function
    End If
    
    Dim tempNum As Double
    temp1 = (Sqr(X ^ 2 + Y ^ 2)) / 2#
    tempNum = i ^ 2 + j ^ 2 - temp1 ^ 2
    If Abs(tempNum) - 0.01 <= 0 Then tempNum = 0.001
    temp2 = Sqr(tempNum)
    angle = 2 * Atn(temp1 / temp2)
    angle = angle * 180# / 3.14159265358979

    'alpha
    con3 = ((X > 0) And (Y = 0) And (i > 0) And (j < 0)) _
        Or ((X = 0) And (Y > 0) And (i > 0) And (j > 0)) _
        Or ((X < 0) And (Y = 0) And (i < 0) And (j > 0)) _
        Or ((X = 0) And (Y < 0) And (i < 0) And (j < 0)) _
        Or ((X > 0) And (Y <> 0) And (j - k * i < 0)) _
        Or ((X < 0) And (Y <> 0) And (j - k * i > 0))
    If con3 = True Then
        getAngleForG02 = angle
        Exit Function
    End If
    
    '360-alpha
    con4 = ((X > 0) And (Y = 0) And (i > 0) And (j > 0)) _
        Or ((X = 0) And (Y > 0) And (i < 0) And (j > 0)) _
        Or ((X < 0) And (Y = 0) And (i < 0) And (j < 0)) _
        Or ((X = 0) And (Y < 0) And (i > 0) And (j < 0)) _
        Or ((X > 0) And (Y <> 0) And (j - k * i > 0)) _
        Or ((X < 0) And (Y <> 0) And (j - k * i < 0))
    If con4 = True Then getAngleForG02 = 360 - angle
End Function

Private Function getAngleForG03(g() As GCode) As Double
    Dim con1 As Boolean
    Dim con2 As Boolean
    Dim con3 As Boolean
    Dim con4 As Boolean
    
    Dim temp1 As Double
    Dim temp2 As Double
    
    Dim angle As Double

    Dim k As Double
    
    Dim X As Double
    Dim Y As Double
    Dim i As Double
    Dim j As Double
    
    X = CDbl(g(0).GVal)
    Y = CDbl(g(1).GVal)
    i = CDbl(g(2).GVal)
    j = CDbl(g(3).GVal)
    
    
    If X = 2.373 Then
        X = X
    End If
    
    
    
    
    '360
    con1 = (X = 0) And (Y = 0)
    If con1 = True Then
        getAngleForG03 = -360#
        Exit Function
    End If
    
    If X <> 0 Then
        k = CDbl(Y / X)
    Else
        k = 1E+21
    End If
    
    '180
    con2 = ((X > 0) And (Y = 0) And (i > 0) And (j = 0)) _
        Or ((X = 0) And (Y > 0) And (i = 0) And (j > 0)) _
        Or ((X < 0) And (Y = 0) And (i < 0) And (j = 0)) _
        Or ((X = 0) And (Y < 0) And (i = 0) And (j < 0)) _
        Or ((X <> 0) And (Y <> 0) And (j - k * i = 0))
    If con2 = True Then
        getAngleForG03 = -180#
        Exit Function
    End If
    
    Dim tempNum As Double
    temp1 = (Sqr(X ^ 2 + Y ^ 2)) / 2#
    tempNum = i ^ 2 + j ^ 2 - temp1 ^ 2
    If Abs(tempNum) - 0.01 <= 0 Then tempNum = 0.001
    temp2 = Sqr(tempNum)
    angle = 2 * Atn(temp1 / temp2)
    angle = angle * 180# / 3.14159265358979

    'alpha
    con4 = ((X > 0) And (Y = 0) And (i > 0) And (j < 0)) _
        Or ((X = 0) And (Y > 0) And (i > 0) And (j > 0)) _
        Or ((X < 0) And (Y = 0) And (i < 0) And (j > 0)) _
        Or ((X = 0) And (Y < 0) And (i < 0) And (j < 0)) _
        Or ((X < 0) And (Y <> 0) And (j - k * i > 0)) _
        Or ((X > 0) And (Y <> 0) And (j - k * i < 0))
    If con4 = True Then getAngleForG03 = -(360# - angle)
    
    '360-alpha
    con3 = ((X > 0) And (Y = 0) And (i > 0) And (j > 0)) _
        Or ((X = 0) And (Y > 0) And (i < 0) And (j > 0)) _
        Or ((X < 0) And (Y = 0) And (i < 0) And (j < 0)) _
        Or ((X = 0) And (Y < 0) And (i > 0) And (j < 0)) _
        Or ((X < 0) And (Y <> 0) And (j - k * i < 0)) _
        Or ((X > 0) And (Y <> 0) And (j - k * i > 0))
    If con3 = True Then getAngleForG03 = -angle
End Function
'#################################################
'读指令序列到分析窗体列表
Private Function readInstructionSquenceToList() As Long
    Dim i As Long
    
    On Error GoTo rISTLerrHandle
    lstMsg.Clear
    lstMsg.AddItem ("********************************************************")
    lstMsg.AddItem ("分析得到的指令序列")
    
    For i = 0 To UBound(instructionSquence)
        lstMsg.AddItem (instructionSquence(i))
    Next i
    
    lstMsg.AddItem ("结束")
    lstMsg.AddItem ("********************************************************")
    
    readInstructionSquenceToList = 0
    Exit Function
rISTLerrHandle:
    lstMsg.AddItem ("指令序列为空")
    readInstructionSquenceToList = -1
End Function
Private Sub returnOrigin()
End Sub

'#############################################################################
'添加一个字符串进一个数组
Private Sub addToArray(codeStr As String, anyArray() As String)

    ReDim Preserve anyArray(arrayCount)
    anyArray(arrayCount) = codeStr
    arrayCount = arrayCount + 1
    
End Sub

Private Sub cmdOK_Click()
    Unload Me
End Sub