Public Type TCut
    x1 As Long
    y1 As Long
    x2 As Long
    y2 As Long
End Type

Dim cuts() As TCut
Dim Ln As Long  ' ðàçìåð ìàññèâà cuts
Dim maxX, maxY As Long  ' ìàêñèìàëüíûå çíà÷åíèÿ (ðàçìåðû ñòåêëà)
Dim eOffset As Long     ' îòñòóï îò êðàÿ ñòåêëà
Dim fso As FileSystemObject, ts As TextStream

Private Sub getCuts()
    Scuts = Split(ActiveCell().Value, "+")
    Ln = UBound(Scuts) - LBound(Scuts) + 1 ' ðàçìåð ìàññèâà Scuts
    i = 1
    ReDim cuts(i To Ln)
    For Each X In Scuts
        s = Mid(X, 2, Len(X) - 2)   ' îáðåçàåì ñêîáêè
        A = Split(s, "-")(0)
        B = Split(s, "-")(1)
        cuts(i).x1 = Split(A, ";")(0)
        cuts(i).y1 = Split(A, ";")(1)
        cuts(i).x2 = Split(B, ";")(0)
        cuts(i).y2 = Split(B, ";")(1)
        i = i + 1
    Next
End Sub

Private Sub Optimize()
    Dim curX As Long, curY As Long
    Dim t1 As Long, t2 As Long
    curX = 0
    curY = 0
    For i = 1 To Ln
        t1 = Abs(cuts(i).x1 - curX) + Abs(cuts(i).y1 - curY)    ' ðàññòîÿíèå îò òåêóùåé òî÷êè äî âåðøèíû x1, y1 îòðåçêà cuts(i)
        t2 = Abs(cuts(i).x2 - curX) + Abs(cuts(i).y2 - curY)    ' ðàññòîÿíèå îò òåêóùåé òî÷êè äî âåðøèíû x2, y2 îòðåçêà cuts(i)
        If t1 > t2 Then     ' åñëè ðàññòîÿíèå äî âåðøèíû x2,y2 ìåíüøå, òî ìåíÿåì êîíöû îòðåçêà ìåñòàìè
            t1 = cuts(i).x1
            t2 = cuts(i).y1
            cuts(i).x1 = cuts(i).x2
            cuts(i).y1 = cuts(i).y2
            cuts(i).x2 = t1
            cuts(i).y2 = t2
        End If
        curX = cuts(i).x2
        curY = cuts(i).y2
        ' ñäåëàòü îòñòóï eOffset ìì, åñëè ðåç íà÷èíàåòñÿ îò êðàÿ ñòåêëà
        If (cuts(i).x1 = 0) Then
            cuts(i).x1 = cuts(i).x1 + eOffset
        End If
        If (cuts(i).x1 = maxX) Then
            cuts(i).x1 = cuts(i).x1 - eOffset
        End If
        If (cuts(i).x2 = 0) Then
            cuts(i).x2 = cuts(i).x2 + eOffset
        End If
        If (cuts(i).x2 = maxX) Then
            cuts(i).x2 = cuts(i).x2 - eOffset
        End If
        
        If (cuts(i).y1 = 0) Then
            cuts(i).y1 = cuts(i).y1 + eOffset
        End If
        If (cuts(i).y1 = maxY) Then
            cuts(i).y1 = cuts(i).y1 - eOffset
        End If
        If (cuts(i).y2 = 0) Then
            cuts(i).y2 = cuts(i).y2 + eOffset
        End If
        If (cuts(i).y2 = maxY) Then
            cuts(i).y2 = cuts(i).y2 - eOffset
        End If
        ' #######################################################
    Next i
End Sub

Sub Gcode()
'
' Gcode Ìàêðîñ
' Ãåíåðèðóåò óïðàâëÿþùóþ ïðîãðàììó äëÿ Mach3
'
' Ñî÷åòàíèå êëàâèø: Ctrl+Shift+A
'
    Dim LiftUp, PutDown, TurnX, TurnY As String
    Dim X, Y As Long    ' òåêóùèå êîîðäèíàòû
    
    LiftUp = "M100 P6 Q1"
    PutDown = "M100 P6 Q0"
    TurnX = "M100 P5 Q1"
    TurnY = "M100 P5 Q0"
    
    maxX = ActiveCell.Offset(0, -5).Value
    maxY = ActiveCell.Offset(0, -4).Value
    eOffset = 1
    
    getCuts
    Optimize
    Set fso = New FileSystemObject
    v = 0
    Do
        s = Format(Date, "dd.mm.yyyy ") & Format(v, "0000") & ".tap"
        v = v + 1
    Loop Until fso.FileExists("C:\G-code\" & s) = False
    Set ts = fso.CreateTextFile("C:\G-code\" & s, True)
    ts.WriteLine ("G90 G21")    '   àáñîëþòíûå êîîðäèíàòû, ìåòðè÷åñêèé ðåæèì
    ts.WriteLine ("G0 F4000")    '   ñîêðîñòü ïåðåìåùåíèÿ â ìì/ìèí
    ts.WriteLine ("G1 F4000")    '   ñîêðîñòü ðåçà â ìì/ìèí
    ts.WriteLine (LiftUp)   'Ïîäíèìàåì ðåçàê
    ts.WriteLine (TurnX)   'Ïîâîðà÷èâàåì ðåçàê ïî õîäó äâèæåíèÿ îñè X
    ts.WriteLine ("G04 P0.5")   'ïàóçà
    ts.WriteLine ("G0 X0")    '   åäåì â home ïî îñè X
    ts.WriteLine (LiftUp)   'Ïîäíèìàåì ðåçàê
    ts.WriteLine (TurnY)   'Ïîâîðà÷èâàåì ðåçàê ïî õîäó äâèæåíèÿ îñè Y
    ts.WriteLine ("G04 P0.5")   'ïàóçà
    ts.WriteLine ("G0 0")    '   åäåì â home ïî îñè Y
    X = 0
    Y = 0
    For i = 1 To Ln
        Debug.Print cuts(i).x1 & ":" & cuts(i).y1 & "-" & cuts(i).x2 & ":" & cuts(i).y2
        ' ïåðåä ðåçîì íåîáõîäèìî óñòàíîâèòü ðåçàê â êîîðäèíàòû x1-y1
        ts.WriteLine (LiftUp)   'ïîäúåì ãîëîâû
        ts.WriteLine ("G04 P0.5")   'ïàóçà
        If cuts(i).x1 <> X Then
            ts.WriteLine (TurnX)   'Ïîâîðà÷èâàåì ðåçàê ïî õîäó äâèæåíèÿ îñè X
            ts.WriteLine ("G04 P0.5")   'ïàóçà
            ts.WriteLine ("G0 X" & cuts(i).x1)
        End If
        If cuts(i).y1 <> Y Then
            ts.WriteLine (TurnY)   'Ïîâîðà÷èâàåì ðåçàê ïî õîäó äâèæåíèÿ îñè Y
            ts.WriteLine ("G04 P0.5")   'ïàóçà
            ts.WriteLine ("G0 Y" & cuts(i).y1)
        End If
        ' ïåðåä îïóñêàíèåì ðåçàêà, íåîáõîäèìî ïîâåðíóòü åãî â íàïðàâëåíèè ðåçà
        If cuts(i).x1 <> cuts(i).x2 Then
            ' ðåç ïî îñè X
            ts.WriteLine (TurnX)   'Ïîâîðà÷èâàåì ðåçàê ïî õîäó äâèæåíèÿ îñè X
            ts.WriteLine (PutDown)   'Îïóñêàåì ðåçàê
            ts.WriteLine ("G04 P1.5")   'ïàóçà
            ts.WriteLine ("G01 X" & cuts(i).x2)
        Else
            ' ðåç ïî îñè Y
            ts.WriteLine (TurnY)   'Ïîâîðà÷èâàåì ðåçàê ïî õîäó äâèæåíèÿ îñè Y
            ts.WriteLine (PutDown)   'Îïóñêàåì ðåçàê
            ts.WriteLine ("G04 P1.5")   'ïàóçà
            ts.WriteLine ("G01 Y" & cuts(i).y2)
        End If
        X = cuts(i).x2
        Y = cuts(i).y2
    Next i
    ts.WriteLine (LiftUp)   'Ïîäíèìàåì ðåçàê
    ts.WriteLine (TurnX)   'Ïîâîðà÷èâàåì ðåçàê ïî õîäó äâèæåíèÿ îñè X
    ts.WriteLine ("G04 P0.5")   'ïàóçà
    ts.WriteLine ("G0 X0")    '   åäåì â home ïî îñè X
    ts.WriteLine (LiftUp)   'Ïîäíèìàåì ðåçàê
    ts.WriteLine (TurnY)   'Ïîâîðà÷èâàåì ðåçàê ïî õîäó äâèæåíèÿ îñè Y
    ts.WriteLine ("G04 P0.5")   'ïàóçà
    ts.WriteLine ("G0 Y0")    '   åäåì â home ïî îñè Y
    ts.WriteLine ("M2")     ' îêîí÷àíèå ðàáîòû
    ts.Close
End Sub
