Sub Main() ' 2010 Circular Pocket Probing Script ' 3-1-11 Dim FRate1, FRate2 Dim DMax, Clearance, EdgeLength, CornerClear Dim XStart, YStart Dim PlateOffset, XOffset, YOffset Dim ZeroYN Dim ToolNo Dim ToolD Dim ProbeD Dim ProbeLengthX, ProbeLengthY Dim XNew, XHit1, Xhit2, XEdge, X1, X2 Dim YNew, YHit1, YHit2, YEdge, Y1, Y2 Dim XPos, YPos, EdgeAngle, PocketXLen, PocketYLen, EdgeDelta, XCenter, YCenter Dim XScale, YScale, ZScale Dim CurrentAbsInc Dim CurrentFeed FRate1 = abs(GetUserDRO(1821)) FRate2 = abs(GetUserDRO(1822)) DMax = abs(GetUserDRO(1823)) PlateOffset = GetUserDRO(1824) ToolNo = GetCurrentTool() ToolD = GetToolParam(ToolNo,1) If GetUserDRO(1829) = 0 then ProbeD = ToolD Else ProbeD = GetUserDRO(1829) End If Clearance = abs(GetUserDRO(1825)) XOffset = GetUserDRO(1826) YOffset = GetUserDRO(1827) EdgeLength = abs(GetUserDRO(1828)) ProbeLengthY = GetOEMDRO(801) + DMax XStart = GetOEMDRO(800) YStart = GetOEMDRO(801) If GetOEMLED(801) Then ' On = English Measure INCH CornerClear = 1.5 Else ' Off = Metric Measure MM CornerClear = 38 End If If GetOEMLED(1871) Then ZeroYN=1 Else ZeroYN=0 End If CurrentFeed = GetOemDRO(818) ' Get the current feedrate to return to later CurrentAbsInc = GetOemLED(48) ' Get the current G90/G91 state 'Get Axis Scale factors XScale = GetOEMDRO(59) YScale = GetOEMDRO(60) ZScale = GetOEMDRO(61) 'Set All Axis' Scale to 1 Call SetOEMDRO(59,1) Call SetOEMDRO(60,1) Call SetOEMDRO(61,1) Sleep(250) 'Check for Errors If GetOemLED(16)<>0 Then ' Check for Machine Coordinates Message "Please change to working coordinates" Call SetOEMDRO(59,XScale) Call SetOEMDRO(60,YScale) Call SetOEMDRO(61,ZScale) Sleep(250) Exit Sub ' Exit if in Machine Coordinates End If If GetOemLED(825)<>0 Then Message "Probe Grounded - Check connection and try again" Call SetOEMDRO(59,XScale) Call SetOEMDRO(60,YScale) Call SetOEMDRO(61,ZScale) Sleep(250) Exit Sub ' Exit if probe is tripped End If Code "G90" Sleep(125) Message "Probing for Y Center....." Sleep(1000) 'Pause 1 second Code "F" & FRate1 Sleep(125) Code "G31 Y" & ProbeLengthY While IsMoving() Wend YHit1 = GetVar(2001) Y1 = YHit1 + ProbeD/2 'Tool position at probe hit. If FRate2=0 Then Code "G0 Y" & YStart While IsMoving() Wend Else Code "G0 Y" & YHit1 - ProbeD/4 While IsMoving() Wend End If If FRate2<>0 Then Code "F" & Frate2 Sleep(150) Code "G31 Y" & ProbeLengthY While IsMoving() Wend YHit1 = GetVar(2001) Y1 = YHit1 + ProbeD/2 'Tool position at probe hit. Code "G0 Y" & YStart While IsMoving() Wend End If ProbeLengthY = YStart-DMax Code "F" & FRate1 Sleep(125) Code "G31 Y" & ProbeLengthY While IsMoving() Wend YHit2 = GetVar(2001) Y2 = YHit2 - ProbeD/2 'Tool position at probe hit. If FRate2<>0 Then Code "G0 Y" & YHit2 + ProbeD/4 While IsMoving() Wend Code "F" & Frate2 Sleep(150) Code "G31 Y" & ProbeLengthY While IsMoving() Wend YHit2 = GetVar(2001) Y2 = YHit2 - ProbeD/2 'Tool position at probe hit. End If YPos = (Y1+Y2)/2 If ZeroYN = 1 then Code "G0 Y" & YPos While IsMoving() Wend SetOEMDRO(801,YOffset) Sleep(150) Else Code "G0 Y" & YStart While IsMoving() Wend End If YCenter = Cstr(YOffset) PathLength = Len(YCenter) For X = 2 To PathLength Step 1 lstring=Mid(YCenter,X,PathLength-X+1) If Left(lstring,1) = "." Then LabelLength = X+5 Exit For End If Next X YCenter=Left(YCenter, LabelLength) Message "Y Center Found.........." Sleep(150) 'X Probing '////////////////////////////// ProbeLengthX = XStart - DMax Message "Probing for X Center....." Sleep(250) 'Pause 1/4 second Code "F" & FRate1 Sleep(125) Code "G31 X" & ProbeLengthX While IsMoving() Wend XHit1 = GetVar(2000) X1 = XHit1 - ProbeD/2 'Tool position at probe hit. If FRate2=0 Then Code "G0 X" & XStart While IsMoving() Wend Else Code "G0 X" & XHit1 + ProbeD/4 While IsMoving() Wend End If If FRate2<>0 Then Message "Slow Probing for X position....." Sleep(100) 'Pause 1/10 second Code "F" & Frate2 Sleep(150) Code "G31 X" & ProbeLengthX While IsMoving() Wend XHit1 = GetVar(2000) X1 = XHit1 - ProbeD/2 'Tool position at probe hit. Code "G0 X" & XStart While IsMoving() Wend End If ProbeLengthX = XStart + DMax Message "Probing for X Center....." Sleep(250) 'Pause 1/4 second Code "F" & FRate1 Sleep(125) Code "G31 X" & ProbeLengthX While IsMoving() Wend XHit2 = GetVar(2000) X2 = XHit2 + ProbeD/2 'Tool position at probe hit. If FRate2=0 Then Code "G0 X" & XStart While IsMoving() Wend Else Code "G0 X" & XHit2 - ProbeD/4 While IsMoving() Wend End If If FRate2<>0 Then Message "Slow Probing for X position....." Sleep(100) 'Pause 1/10 second Code "F" & Frate2 Sleep(150) Code "G31 X" & ProbeLengthX While IsMoving() Wend XHit2 = GetVar(2000) X2 = XHit2 + ProbeD/2 'Tool position at probe hit. End If XPos = (X1+X2)/2 If ZeroYN = 1 then Code "G0 X" & XPos While IsMoving() Wend SetOEMDRO(800,XOffset) Sleep(150) Else Code "G0 X" & XStart While IsMoving() Wend End If XCenter = Cstr(XOffset) PathLength = Len(XCenter) For X = 2 To PathLength Step 1 lstring=Mid(XCenter,X,PathLength-X+1) If Left(lstring,1) = "." Then LabelLength = X+5 Exit For End If Next X XCenter=Left(XCenter, LabelLength) Message "X Center Found.........." Sleep(150) SetUserLabel (9,XCenter) SetUserLabel (10,YCenter) Code "F" & CurrentFeed ' Reset to original feed rate If CurrentAbsInc = 0 Then 'if G91 was in effect before then return to it Code "G91" End If Call SetOEMDRO(59,XScale) Call SetOEMDRO(60,YScale) Call SetOEMDRO(61,ZScale) Sleep(250) Message "Center Found" If GetOemLED(1872) Then SetUserLED(1870,0) End Sub