cnc-club.ru

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 + YOffset '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 + YOffset '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 - YOffset '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 - YOffset 'Tool position at probe hit.

End If

YPos = (Y1+Y2)/2


If ZeroYN = 1 then
Code "G0 Y" & YPos
While IsMoving()
Wend

SetOEMDRO(801,0)
Sleep(150)
Else

Code "G0 Y" & YStart
While IsMoving()
Wend

End If



YCenter = Cstr(YPos)


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 - XOffset '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 - XOffset '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 + XOffset '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 + XOffset 'Tool position at probe hit.



End If

XPos = (X1+X2)/2



If ZeroYN = 1 then
Code "G0 X" & XPos
While IsMoving()
Wend
SetOEMDRO(800,0)
Sleep(150)
Else

Code "G0 X" & XStart
While IsMoving()
Wend

End If

XCenter = Cstr(XPos)


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