Option Explicit
Sub Get_Rect_Machine_Values()
'Range("C8:C20").NumberFormat = "0.####"
'Get Machining Values from Rgh Cir Pckt WrkSht, C8 thru C19
Dim cutterDia As Double
cutterDia = Range("C8").Value
Dim uprLeftCrnrX As Double
uprLeftCrnrX = Range("C9").Value
Dim uprLeftCrnrY As Double
uprLeftCrnrY = Range("C10").Value
Dim pcktLenX As Double
pcktLenX = Range("C11").Value
Dim pcktLenY As Double
pcktLenY = Range("C12").Value
Dim totDepthZ As Double
totDepthZ = Range("C13").Value
Dim crnrRad As Double
crnrRad = Range("C14").Value
Dim radCutWidth As Double
radCutWidth = Range("C15").Value
Dim stkFshSide As Double
stkFshSide = Range("C16").Value
Dim docZ As Double
docZ = Range("C17").Value
Dim stkFshZ As Double
stkFshZ = Range("C18").Value
Dim leadRadOnOff As Double
leadRadOnOff = Range("C19").Value
Dim leadInTan As Double
leadInTan = Range("C20").Value
Dim feedRateRgh As String
feedRateRgh = Range("C21").Value
Dim feedRateFsh As String
feedRateFsh = Range("C22").Value
Dim toolNumRgh As Integer
toolNumRgh = Range("C23").Value
Dim toolNumFsh As Integer
toolNumFsh = Range("C24").Value
Dim operNum As String
operNum = Range("C25").Value
Dim fileName As String
fileName = Range("C26").Value
Dim filePath As String
filePath = Range("C27").Value
Dim fullFilePath As String
Dim toolNum As Integer
toolNum = toolNumRgh
Dim rghRPM As Integer
rghRPM = Range("C28").Value
Dim fshRPM As Integer
fshRPM = Range("C29").Value
Dim spndlDir As String
spndlDir = Range("C30").Value
Dim pcktCtrLocX As Double
pcktCtrLocX = uprLeftCrnrX + (pcktLenX / 2)
Dim pcktCtrLocY As Double
pcktCtrLocY = uprLeftCrnrY + ((pcktLenY / 2) * -1)
'Test Pocket Center Calculations
'Range("D11").Value = pcktCtrLocX
'Range("D12").Value = pcktCtrLocY
Dim answer As VbMsgBoxResult
fullFilePath = Dir(filePath & "\" & fileName & "_" & operNum & ".txt")
If fullFilePath = "" Then
answer = MsgBox("File Does Not Exist. Create File?", vbYesNo, "File Verification")
Select Case answer
Case vbYes
fullFilePath = filePath & "\" & fileName & "_" & operNum & ".txt"
Open fullFilePath For Append As #1
Close #1
Case Else
MsgBox "File Name Not Created"
End Select
Else
answer = MsgBox("Backup File or Delete old File", vbOKOnly, "File Exists")
End If
'Test Retrieval of Machining Values
'Range("C40").Value = cutterDia
'Range("C41").Value = cirRad
'Range("C42").Value = fileName
Dim rghMatX As Double
rghMatX = (pcktLenX / 2) - (cutterDia / 2) - stkFshSide
Dim rghMatZ As Double
rghMatZ = (totDepthZ - stkFshZ) * -1
'Test Calculations
'Range("H17").Value = rghMatRad
'Range("H18").Value = rghMatZ
'Create & Output Prog Num, Header Note & code
Dim progNum As String
progNum = "O1001"
Dim progHeader As String
progHeader = "(" & fileName & "_" & operNum & "," & "OP." & operNum & "," & Now & ")"
Dim startCode As String
'startCode = "G90G54G0" & "X" & pcktCtrLocX & "Y" & pcktCtrLocY
startCode = "G90G54G0"
Dim zStart As String
zStart = "G43Z0.1" & "H" & toolNum & "M8"
'Open File for Output
Open fullFilePath For Append As #1
Print #1, progNum
Print #1, progHeader
Print #1, "M6" & "T" & toolNum
Print #1, "S" & rghRPM & spndlDir
Print #1, startCode & "X" & Format(pcktCtrLocX, "0.#####") & "Y" & Format(pcktCtrLocY, "0.#####")
Print #1, zStart
'Close #1
'Set Limiting Check Values
Dim zDepth As Double
zDepth = 0
zDepth = zDepth + (docZ * -1)
'Set Counters
Dim radWidth As Double
radWidth = 0
radWidth = radWidth + radCutWidth
Dim radWidthX As Double
radWidthX = radCutWidth
Dim radWidthY As Double
radWidthY = ((pcktLenY / 2) - (cutterDia / 2) - stkFshSide) _
/ (((pcktLenX / 2) - (cutterDia / 2) - stkFshSide) / radCutWidth)
'Range("G18").Value = radWidthY
radWidthY = Format(radWidthY, "0.####")
Dim passNum As Integer
passNum = 1
'Calc and Output X,Y,Z Rghing Passes
Do While zDepth > rghMatZ
'Calc next Z-level
Dim nextZCut As Double
nextZCut = zDepth * passNum
'Output Z movement to file
'Open fullFilePath For Append As #1
'G1 Z-(zDepth)
Print #1, "G1" & "Z" & nextZCut & "F" & Format(feedRateFsh, "0.####")
'Close #1
Do While radWidth < rghMatX
'Calc X,Y Cut Location Prior to Rectangular Cut
Dim xPosCutLoc As Double
xPosCutLoc = pcktCtrLocX + (radWidthX * passNum)
Dim yPosCutLoc As Double
yPosCutLoc = pcktCtrLocY + (radWidthY * passNum)
Dim xNegCutLoc As Double
xNegCutLoc = pcktCtrLocX - (radWidthX * passNum)
Dim yNegCutLoc As Double
yNegCutLoc = pcktCtrLocY - (radWidthY * passNum)
'Output X,Y Linear interpolation
'Open fullFilePath For Append As #1
Print #1, "X" & Format(xPosCutLoc, "0.####") & "Y" & Format(yPosCutLoc, "0.####") & "F" & Format(feedRateRgh, "0.####")
'Print #1, "Y" & yPosCutLoc
Print #1, "X" & Format(xNegCutLoc, "0.####")
Print #1, "Y" & Format(yNegCutLoc, "0.####")
Print #1, "X" & Format(xPosCutLoc, "0.####")
Print #1, "Y" & Format(pcktCtrLocY, "0.####")
'Close #1
'G1 X(xCutLoc) Y(yCutLoc) F(feedRateRgh)
passNum = passNum + 1
radWidth = radCutWidth * passNum
Loop
'Output last X,Y Rough Passes at Current Z-Level
xPosCutLoc = pcktCtrLocX + (pcktLenX / 2) - stkFshSide - (cutterDia / 2)
yPosCutLoc = pcktCtrLocY + (pcktLenY / 2) - stkFshSide - (cutterDia / 2)
xNegCutLoc = pcktCtrLocX - (pcktLenX / 2) + stkFshSide + (cutterDia / 2)
yNegCutLoc = pcktCtrLocY - (pcktLenY / 2) + stkFshSide + (cutterDia / 2)
'Open fullFilePath For Append As #1
Print #1, "X" & Format(xPosCutLoc, "0.####") & "Y" & Format(yPosCutLoc, "0.####")
'Print #1, "Y" & yPosCutLoc
Print #1, "X" & Format(xNegCutLoc, "0.####")
Print #1, "Y" & Format(yNegCutLoc, "0.####")
Print #1, "X" & Format(xPosCutLoc, "0.####")
Print #1, "Y" & Format(pcktCtrLocY, "0.####")
Print #1, "Y" & Format(yPosCutLoc, "0.####") & "F" & Format((feedRateRgh * 1.25), "0.####")
'Reset Counters
passNum = 1
radWidth = radCutWidth
'Output Retract and Reposition to Rect Pckt Center
Dim escapeZ As String
escapeZ = "G0Z0.1"
Print #1, escapeZ
'X(ctrLocX) Y(ctrLocY)
Dim pcktStart As String
pcktStart = "X" & Format(pcktCtrLocX, "0.####") & "Y" & Format(pcktCtrLocY, "0.####")
Print #1, pcktStart
'G1 Z-(zDepth +0.02)
Dim cutLevelZ As String
cutLevelZ = "G1" & "Z" & Format((zDepth + 0.02), "0.####")
Print #1, cutLevelZ & "F" & Format(feedRateRgh, "0.####")
zDepth = zDepth + (docZ * -1)
Loop
'Make Last X,Y Rgh Passes at Last Rgh Z-Level
Dim zCode As String
zCode = "G1" & "Z" & rghMatZ & "F" & Format(feedRateFsh, "0.####")
Print #1, zCode
Do While radWidth < rghMatX
'Calc X,Y Cut Location Prior to Circle Cut
'Dim xPosCutLoc As Double
xPosCutLoc = pcktCtrLocX + (radWidthX * passNum)
'Dim yPosCutLoc As Double
yPosCutLoc = pcktCtrLocY + (radWidthY * passNum)
'Dim xNegCutLoc As Double
xNegCutLoc = pcktCtrLocX - (radWidthX * passNum)
'Dim yNegCutLoc As Double
yNegCutLoc = pcktCtrLocY - (radWidthY * passNum)
'Output X,Y Linear interpolation
'Open fullFilePath For Append As #1
Print #1, "X" & Format(xPosCutLoc, "0.####") & "Y" & Format(yPosCutLoc, "0.####") & "F" & Format(feedRateRgh, "0.####")
'Print #1, "Y" & yPosCutLoc
Print #1, "X" & Format(xNegCutLoc, "0.####")
Print #1, "Y" & Format(yNegCutLoc, "0.####")
Print #1, "X" & Format(xPosCutLoc, "0.####")
Print #1, "Y" & Format(pcktCtrLocY, "0.####")
'Close #1
'G1 X(xCutLoc) Y(yCutLoc) F(feedRateRgh)
passNum = passNum + 1
radWidth = radCutWidth * passNum
Loop
'Output last X,Y Rough Passes at Current Z-Level
xPosCutLoc = pcktCtrLocX + (pcktLenX / 2) - stkFshSide - (cutterDia / 2)
yPosCutLoc = pcktCtrLocY + (pcktLenY / 2) - stkFshSide - (cutterDia / 2)
xNegCutLoc = pcktCtrLocX - (pcktLenX / 2) + stkFshSide + (cutterDia / 2)
yNegCutLoc = pcktCtrLocY - (pcktLenY / 2) + stkFshSide + (cutterDia / 2)
'Open fullFilePath For Append As #1
Print #1, "X" & Format(xPosCutLoc, "0.####") & "Y" & Format(yPosCutLoc, "0.####") & "F" & Format(feedRateRgh, "0.####")
'Print #1, "Y" & yPosCutLoc
Print #1, "X" & Format(xNegCutLoc, "0.####")
Print #1, "Y" & Format(yNegCutLoc, "0.####")
Print #1, "X" & Format(xPosCutLoc, "0.####")
Print #1, "Y" & Format(pcktCtrLocY, "0.####")
Print #1, "Y" & Format(yPosCutLoc, "0.####") & "F" & Format((feedRateRgh * 1.25), "0.####")
'Reset Counters
passNum = 1
radWidth = radCutWidth
'Output Retract and Reposition to Circle Pckt Center
'Dim escapeZ As String
escapeZ = "G0Z0.1"
Print #1, escapeZ
Close #1
'Check for different Finish Tool Number
If toolNumFsh <> toolNumRgh Then
toolNum = toolNumFsh
Dim retractZ As String
retractZ = "G91G28G0Z0M9"
Dim homeXY As String
homeXY = "G28G0X0Y0M5"
Dim toolChg As String
toolChg = "M6" & "T" & toolNum
'hCode = "G43Z0.1" & "H" & toolNum & "M8"
'Open File for Output
Open fullFilePath For Append As #1
Print #1, retractZ
Print #1, homeXY
Print #1, toolChg
Print #1, "S" & fshRPM & spndlDir
Print #1, startCode & "X" & Format(pcktCtrLocX, "0.#####") & "Y" & Format(pcktCtrLocY, "0.#####")
'Print #1, hCode
Print #1, "G43Z0.1" & "H" & toolNum & "M8"
Close #1
End If
'Create and Output Finish Passes
Open fullFilePath For Append As #1
If toolNumFsh = toolNumRgh Then
Print #1, "X" & Format(pcktCtrLocX, "0.#####") & "Y" & Format(pcktCtrLocY, "0.#####")
End If
Print #1, "G1" & "Z" & (rghMatZ + 0.1) & "F" & Format(feedRateRgh, "0.####")
Print #1, "Z" & (totDepthZ * -1) & "F" & Format(feedRateFsh, "0.####")
radWidth = 0
radWidth = radWidth + radCutWidth
passNum = 1
Do While radWidth < rghMatX
'Calc X,Y Cut Location Prior to Circle Cut
'Dim xPosCutLoc As Double
xPosCutLoc = pcktCtrLocX + (radWidthX * passNum)
'Dim yPosCutLoc As Double
yPosCutLoc = pcktCtrLocY + (radWidthY * passNum)
'Dim xNegCutLoc As Double
xNegCutLoc = pcktCtrLocX - (radWidthX * passNum)
'Dim yNegCutLoc As Double
yNegCutLoc = pcktCtrLocY - (radWidthY * passNum)
'Output X,Y Linear interpolation
'Open fullFilePath For Append As #1
Print #1, "X" & Format(xPosCutLoc, "0.####") & "Y" & Format(yPosCutLoc, "0.####") & "F" & Format(feedRateRgh, "0.####")
'Print #1, "Y" & yPosCutLoc
Print #1, "X" & Format(xNegCutLoc, "0.####")
Print #1, "Y" & Format(yNegCutLoc, "0.####")
Print #1, "X" & Format(xPosCutLoc, "0.####")
Print #1, "Y" & Format(pcktCtrLocY, "0.####")
'Close #1
'G1 X(xCutLoc) Y(yCutLoc) F(feedRateRgh)
passNum = passNum + 1
radWidth = radCutWidth * passNum
Loop
'Output last X,Y Rough Passes as Current Z-Level
xPosCutLoc = pcktCtrLocX + (pcktLenX / 2) - stkFshSide - (cutterDia / 2)
yPosCutLoc = pcktCtrLocY + (pcktLenY / 2) - stkFshSide - (cutterDia / 2)
xNegCutLoc = pcktCtrLocX - (pcktLenX / 2) + stkFshSide + (cutterDia / 2)
yNegCutLoc = pcktCtrLocY - (pcktLenY / 2) + stkFshSide + (cutterDia / 2)
'Open fullFilePath For Append As #1
Print #1, "X" & Format(xPosCutLoc, "0.####") & "Y" & Format(yPosCutLoc, "0.####") & "F" & Format(feedRateRgh, "0.####")
'Print #1, "Y" & yPosCutLoc
Print #1, "X" & Format(xNegCutLoc, "0.####")
Print #1, "Y" & Format(yNegCutLoc, "0.####")
Print #1, "X" & Format(xPosCutLoc, "0.####")
Print #1, "Y" & Format(pcktCtrLocY, "0.####")
Print #1, "Y" & Format(yPosCutLoc, "0.####") & "F" & Format((feedRateRgh * 1.25), "0.####")
'Reset Counters
passNum = 1
radWidth = radCutWidth
'Output Retract and Reposition to Circle Pckt Center
'Dim escapeZ As String
escapeZ = "G0Z0.1"
Print #1, escapeZ
'Create and Output Final Profile Pass
'Dim retractZ As String
retractZ = "G91G28G0Z0M9"
'Dim homeXY As String
homeXY = "G28G0X0Y0M5"
Dim startProfX As Double
Dim startProfY As Double
startProfX = pcktCtrLocX + leadRadOnOff
startProfY = pcktCtrLocY + (pcktLenY / 2) - (cutterDia / 2) - leadRadOnOff - leadInTan
Print #1, "G0" & "X" & Format(startProfX, "0.####") & "Y" & Format(startProfY, "0.####")
Print #1, "G1" & "Z" & (rghMatZ + 0.1) & "F" & Format(feedRateRgh, "0.####")
Print #1, "Z" & (totDepthZ * -1) & "F" & Format(feedRateFsh, "0.####")
Print #1, "G41" & "X" & Format(startProfX, "0.####") & "Y" & Format((pcktCtrLocY + (pcktLenY / 2) - (cutterDia / 2) - leadRadOnOff), "0.####") & "D" & toolNum; "F" & Format(feedRateFsh, "0.####")
Print #1, "G3" & "X" & Format(pcktCtrLocX, "0.####") & "Y" & Format((pcktCtrLocY + (pcktLenY / 2) - (cutterDia / 2)), "0.####") & "I-" & Format(leadRadOnOff, "0.####")
Print #1, "G1" & "X" & Format((pcktCtrLocX - (pcktLenX / 2) + (cutterDia / 2)), "0.####")
Print #1, "Y" & Format((pcktCtrLocY - (pcktLenY / 2) + (cutterDia / 2)), "0.####")
Print #1, "X" & Format((pcktCtrLocX + (pcktLenX / 2) - (cutterDia / 2)), "0.####")
Print #1, "Y" & Format((pcktCtrLocY + (pcktLenY / 2) - (cutterDia / 2)), "0.####")
Print #1, "X" & Format(pcktCtrLocX, "0.####")
Print #1, "G3" & "X" & Format((pcktCtrLocX - leadRadOnOff), "0.####") & "Y" & Format((pcktCtrLocY + (pcktLenY / 2) - (cutterDia / 2) - leadRadOnOff), "0.####") & "F" & Format(feedRateRgh, "0.####")
Print #1, "G1G40" & "X" & Format((pcktCtrLocX - leadRadOnOff), "0.####") & "Y" & Format(startProfY, "0.####")
Print #1, escapeZ & "M9"
Print #1, retractZ
Print #1, homeXY
Print #1, "M30"
Print #1, "%"
Close #1
End Sub