'Macro M6Start 12 Station ATC  for JEFF

Message" "                   ' Clear the Message bar

DoSpinStop()                 ' Make sure the spindle is OFF
Code"M09"                    ' Make sure the coolant is OFF

If  GetOEMLed(807) And  GetOemLED(808) And  GetOemLed(809) And  GetOemled(811) Then
MsgBox" 1 or more axis are  NOT REFERENCED cancel program and REF XYZB axis"
End
End If
 
Dim OldTool As Single
Dim NewTool As Single
Dim X As Double
Dim Y As Double
Dim Z As Double
Dim Frate As Double
Dim AtcRate As Double
Dim ToolUpPosition As Double
Dim ToolDownPosition As Double
'********************************
OldTool = GetCurrentTool()
NewTool = GetSelectedTool()
Frate = GetDro( 18)
AtcrRate = 100
ToolUpPosition = GetUserDRO(2000)
ToolDownPosition = GetUserDRO(2001)

If NewTool = OldTool Then        ' Check the tool Number for same tool#
Message" Same Tool,  NO ACTION"
End
End If

If  NewTool > 12 Or NewTool < 1 Then   ' Verify Tool # is between 1-12
MsgBox" Tool # not a valid Number 1-12 ONLY, ENDING Program RUN "
DoButton(3)
End
End If



x = GetUserDRO( 1200 )            ' Tool change location
y = GetUserDRO( 1201 )
z = GetUserDRO( 1202 )


'******************************

Code"G00"
Code "G53Z" & z
Code "G53X" & x & "Y" & y         ' Move to machine corrd position of tool change
While IsMoving()
Wend
Sleep(2000)


GotoToolDownPosition = 2001		  ' Moves Z Axis to -2.5 to drop off old tool tool
While IsMoving()		  ' Wait for move to complete
Sleep 5000			  ' Let other processes have CPU while we wait
Wend


ActivateSignal(OutPut4)           ' Activate air cylinder for atc slide extend
Cnt1 = 0
While Not GetOEMLED(821)          ' Wait until end of travel signal is seen or timeout
   If Cnt1 > 1000 Then
   MsgBox(" Atc EXT. timeout ")
   DoButton(3)   'Cancel Program
   End      ' Cancel Macro
   End If
Sleep(100)
Cnt1 = (Cnt1 +1)
Wend


ActivateSignal(OutPut5)           ' Activate PDB air cylinder to Release Tool
Cnt2 = 0
While Not GetOEMLED(823)          ' Wait until end of travel signal is seen or timeout
   If Cnt2 > 1000 Then
   MsgBox(" Atc EXTEND  timeout ")
   DoButton(3)    'Cancel Program
   End      ' Cancel Macro
   End If
Sleep(100)
Cnt2 = (Cnt2 +1)
Wend


GotoToolUpPosition = 2000	  ' Moves Z Axis to -.6 to let carousel spin
While IsMoving()		  ' Wait for move to complete
Sleep 5000			  ' Let other processes have the CPU while we wait
Wend

SetDro(18, AtcRate)		  ' 18 is the feed rate DRO
Call MovePos(NewTool)		  ' The ATC moves to the new tool
While IsMoving()
Wend


Call GotoToolDownPosition()	  ' Moves Z Axis to -2.5 to pickup tool
While IsMoving()		  ' Wait for move to complete
Sleep 5000			  ' Let other processes have CPU while we wait
Wend



DeactivateSignal(OutPut5)          ' PDB Grips new tool
Cnt3 =0
While Not  GetOEMLED(824)    	  ' wait until end of travel signal is seen
If Cnt3 > 1000 Then
   MsgBox(" Atc LOWER timeout ")
   DoButton(3)                    ' Cancel Program
   End                            ' Cancel Macro
   End If
Sleep(100)
Cnt3 = (Cnt3 +1)
Wend



DeactivateSignal(OutPut4)         ' Deactivate air cylinder for ATC slide Retract
Cnt4 = 0
While Not GetOEMLED(822)          ' Wait until return to position signal is seen
If Cnt4 > 1000 Then
   MsgBox(" Atc RAISE timeout ")
   DoButton(3)     ' Cancel Program
   End      ' Cancel Macro
   End If
Sleep(100)
Cnt4 = (Cnt4 +1)
Wend


SetOemDro(824,NewTool)              ' Update tool # dro
SetDro(18,Frate)             'Set Feedrate back to programed rate   
Message" Tool Change Complete"

Sub MovePos(ByVal ToolNumber As Integer)           'This is the SUB routine for rotation

Select Case ToolNumber      'Positions to each tool in B-axis
      Case  = 1
        Code "G01 G53 B0 "
      Case  = 2
        Code "G01 G53 B30 "
      Case  = 3
        Code "G01 G53 B60 "
      Case  = 4
        Code "G01 G53 B90 "
      Case  = 5
        Code "G01 G53 B120 "
      Case  = 6
        Code "G01 G53 B150 "
      Case  = 7
        Code "G01 G53 B180 "
      Case  = 8
        Code "G01 G53 B210 "
      Case  = 9
        Code "G01 G53 B240 "
      Case  = 10
        Code "G01 G53 B270 "
      Case  = 11
        Code "G01 G53 B300 "
      Case  = 12
        Code "G01 G53 B330 "   
End Select

End Sub