1571
General Mach Discussion / Re: CNC Lathe turret tool changer help?
« on: October 19, 2015, 09:21:46 AM »
Ok,
sounds good.
Thomas
sounds good.
Thomas
This section allows you to view all posts made by this member. Note that you can only see posts made in areas you currently have access to.
Sub Main()
' -------------------------------------------------------------------------------
' TPS 19.10.2015
' Toolchange for a 8 place turret (single step)
' V 5.0.1
' -------------------------------------------------------------------------------
' pin2 is mapped to Input1
' pin3 is mapped to Input2
' pin4 is mapped to Input3
' pin5 is mapped to Input4
' charger seated is mapped to OEMTRIG1
'get the new tool ---------------------------------------------------------------
tool = GetSelectedTool()
' nothing to do
If GetSelectedTool() = GetCurrentTool() Then
message("Tool is the same NO tool change needed")
End
End If
If tool > 8 Or tool < 1 Then 'check tool number to be in range
Message (" Tool " & tool & " is not a valid Number 1-8 ONLY, ENDING Program RUN ")
DoButton(3)
End
End If
tryagain:
'get actual starttime
Starttime = Timer
Message "Moving to Tool# " &GetselectedTool()
Akttime = Timer
While Akttime - Starttime < 50 'try until timeout
ActivateSignal(OutPut5) 'unlocks stop dog
Sleep(1000) 'wait for a second
ActivateSignal(OutPut6) 'turn air motor on
Sleep(1000) 'wait for a second
DeActivateSignal(OutPut5) 'locks stop dog
Sleep(1000) 'wait for a second
DeActivateSignal(OutPut6) 'turn air motor off
Sleep(1000)
'check the position
If GetTurret() = tool Then
GoTo finished
End If
Akttime = Timer
If Akttime - Starttime > 40 Then 'Timeout 20s
Message("Turret timeout")
DeActivateSignal(output5) 'locks stop dog
Sleep(1000) 'wait for a second
DeActivateSignal(OutPut6) 'turn air motor off
End
End If
Wend
finished:
'recheck the turretpos and retry
If GetTurret() <> tool then
GoTo tryagain
End If
'look for OEMTRIG1
If Not IsActive(OEMTRIG1) Then
DOButton(3)
MsgBox("Tool changer not seated!")
End
End If
Message("Tool " & tool & " Loaded")
SetCurrentTool( tool )
End Sub
'function to get the actual turret position
Function GetTurret() As Long
GetTurret = 0
If IsActive(Input1) Then
GetTurret = GetTurret + 1
End If
If IsActive(Input2) Then
GetTurret = GetTurret + 2
End If
If IsActive(Input3) Then
GetTurret = GetTurret + 4
End If
If IsActive(Input4) Then
GetTurret = GetTurret + 8
End If
End Function
Sub Main()
' -------------------------------------------------------------------------------
' TPS 18.10.2015
' Toolchange for a 8 place turret (single step)
' V 5.0.0
' -------------------------------------------------------------------------------
' pin2 is mapped to Input1
' pin3 is mapped to Input2
' pin4 is mapped to Input3
' pin5 is mapped to Input4
' charger seated is mapped to OEMTRIG1
'get the new tool ---------------------------------------------------------------
tool = GetSelectedTool()
' nothing to do
If GetSelectedTool() = GetCurrentTool() Then
message("Tool is the same NO tool change needed")
End
End If
If tool > 8 Or tool < 1 Then 'check tool number to be in range
Message (" Tool " & tool & " is not a valid Number 1-8 ONLY, ENDING Program RUN ")
DoButton(3)
End
End If
Dim StopDog as boolean
tryagain:
'get actual starttime
Starttime = Timer
Message "Moving to Tool# " &GetselectedTool()
Akttime = Timer
While Akttime - Starttime < 40 'try until timeout
ActivateSignal(output5) 'unlocks stop dog
StopDog = True
Sleep(1000) 'wait for a second
ActivateSignal(OutPut6) 'turn air motor on
'wenn we left the turretpos lock the stop dog
If GetTurret() = 0 Then
DeActivateSignal(output5) 'locks stop dog
StopDog = false
End if
If ((GetTurret() <> 0) and (StopDog = False)) Then
DeActivateSignal(OutPut6) 'turn air motor off
sleep(1000)
End if
'check the position
If GetTurret() = tool Then
GoTo finished
End If
Akttime = Timer
If Akttime - Starttime > 30 Then 'Timeout 20s
Message("Turret timeout")
DeActivateSignal(output5) 'locks stop dog
Sleep(1000) 'wait for a second
DeActivateSignal(OutPut6) 'turn air motor off
End
End If
Wend
finished:
'recheck the turretpos and retry
If GetTurret() <> tool then
GoTo tryagain
End If
'look for OEMTRIG1
If Not IsActive(OEMTRIG1) Then
DOButton(3)
MsgBox("Tool changer not seated!")
End
End If
Message("Tool " & tool & " Loaded")
SetCurrentTool( tool )
End Sub
'function to get the actual turret position
Function GetTurret() As Long
GetTurret = 0
If IsActive(Input1) Then
GetTurret = GetTurret + 1
End If
If IsActive(Input2) Then
GetTurret = GetTurret + 2
End If
If IsActive(Input3) Then
GetTurret = GetTurret + 4
End If
If IsActive(Input4) Then
GetTurret = GetTurret + 8
End If
End Function
Sub Main()
' -------------------------------------------------------------------------------
' TPS 18.10.2015
' Toolchange for a 8 place turret
' V 4.0.1
' -------------------------------------------------------------------------------
' pin2 is mapped to Input1
' pin3 is mapped to Input2
' pin4 is mapped to Input3
' pin5 is mapped to Input4
' charger seated is mapped to OEMTRIG1
'get the new tool ---------------------------------------------------------------
tool = GetSelectedTool()
' nothing to do
If GetSelectedTool() = GetCurrentTool() Then
message("Tool is the same NO tool change needed")
End
End If
If tool > 8 Or tool < 1 Then 'check tool number to be in range
Message (" Tool " & tool & " is not a valid Number 1-8 ONLY, ENDING Program RUN ")
DoButton(3)
End
End If
Dim NextTurretPos As Long
NextTurretPos = 0
'get actual starttime
Starttime = Timer
Message "Moving to Tool# " &GetselectedTool()
tryagain:
ActivateSignal(output5) 'unlocks stop dog
Sleep(1000) 'wait for a second
ActivateSignal(OutPut6) 'turn air motor on
While NextTurretPos <> tool 'turn until we are in the wright position
NextTurretPos = GetNextTurret()
'give the other inputs a chance
If NextTurretPos <> 0 Then
Sleep(50)
NextTurretPos = GetNextTurret() 'read NextTurretpos again
End if
Akttime = Timer
If Akttime - Starttime > 20 Then 'Timeout 20s
Message("Turret timeout")
DeActivateSignal(output5) 'locks stop dog
Sleep(1000) 'wait for a second
DeActivateSignal(OutPut6) 'turn air motor off
End
End If
Wend
DeActivateSignal(output5) 'locks stop dog
Sleep(1000) 'wait for a second
DeActivateSignal(OutPut6) 'turn air motor off
sleep(1000)
'recheck the turretpos and retry
If GetTurret() <> tool then
GoTo tryagain
End If
'look for OEMTRIG1
If Not IsActive(OEMTRIG1) Then
DOButton(3)
MsgBox("Tool changer not seated!")
End
End If
Message("Tool " & tool & " Loaded")
SetCurrentTool( tool )
End Sub
'function to get the actual turret position
Function GetTurret() As Long
GetTurret = 0
If IsActive(Input1) Then
GetTurret = GetTurret + 1
End If
If IsActive(Input2) Then
GetTurret = GetTurret + 2
End If
If IsActive(Input3) Then
GetTurret = GetTurret + 4
End If
If IsActive(Input4) Then
GetTurret = GetTurret + 8
End If
End Function
'function to get the next actual turret position
Function GetNextTurret() As Long
GetNextTurret = 0
If IsActive(Input1) Then
GetNextTurret = GetNextTurret + 1
End If
If IsActive(Input2) Then
GetNextTurret = GetNextTurret + 2
End If
If IsActive(Input3) Then
GetNextTurret = GetNextTurret + 4
End If
If IsActive(Input4) Then
GetNextTurret = GetNextTurret + 8
End If
If GetNextTurret = 8 Then
GetNextTurret = 1
Else
GetNextTurret = GetNextTurret + 1
End If
End Function
Sub Main()
' -------------------------------------------------------------------------------
' TPS 18.10.2015
' Toolchange for a 8 place turret
' V 4.0.0
' -------------------------------------------------------------------------------
' pin2 is mapped to Input1
' pin3 is mapped to Input2
' pin4 is mapped to Input3
' pin5 is mapped to Input4
' charger seated is mapped to OEMTRIG1
'get the new tool ---------------------------------------------------------------
tool = GetSelectedTool()
' nothing to do
If GetSelectedTool() = GetCurrentTool() Then
message("Tool is the same NO tool change needed")
End
End If
If tool > 8 Or tool < 1 Then 'check tool number to be in range
Message (" Tool " & tool & " is not a valid Number 1-8 ONLY, ENDING Program RUN ")
DoButton(3)
End
End If
Dim NextTurretPos As Long
NextTurretPos = 0
'get actual starttime
Starttime = Timer
Message "Moving to Tool# " &GetselectedTool()
tryagain:
ActivateSignal(output5) 'unlocks stop dog
Sleep(1000) 'wait for a second
ActivateSignal(OutPut6) 'turn air motor on
While NextTurretPos <> tool 'turn until we are in the wright position
NextTurretPos = GetNextTurret()
'give the other inputs a chance
If ActTurretPos <> 0 Then
Sleep(50)
NextTurretPos = GetNextTurret() 'read NextTurretpos again
End if
Akttime = Timer
If Akttime - Starttime > 20 Then 'Timeout 20s
Message("Turret timeout")
DeActivateSignal(output5) 'locks stop dog
Sleep(1000) 'wait for a second
DeActivateSignal(OutPut6) 'turn air motor off
End
End If
Wend
DeActivateSignal(output5) 'locks stop dog
Sleep(1000) 'wait for a second
DeActivateSignal(OutPut6) 'turn air motor off
sleep(1000)
'recheck the turretpos and retry
If GetTurret() <> tool then
GoTo tryagain
End If
'look for OEMTRIG1
If Not IsActive(OEMTRIG1) Then
DOButton(3)
MsgBox("Tool changer not seated!")
End
End If
Message("Tool " & tool & " Loaded")
SetCurrentTool( tool )
End Sub
'function to get the actual turret position
Function GetTurret() As Long
GetTurret = 0
If IsActive(Input1) Then
GetTurret = GetTurret + 1
End If
If IsActive(Input2) Then
GetTurret = GetTurret + 2
End If
If IsActive(Input3) Then
GetTurret = GetTurret + 4
End If
If IsActive(Input4) Then
GetTurret = GetTurret + 8
End If
End Function
'function to get the next actual turret position
Function GetNextTurret() As Long
GetNextTurret = 0
If IsActive(Input1) Then
GetNextTurret = GetNextTurret + 1
End If
If IsActive(Input2) Then
GetNextTurret = GetNextTurret + 2
End If
If IsActive(Input3) Then
GetNextTurret = GetNextTurret + 4
End If
If IsActive(Input4) Then
GetNextTurret = GetNextTurret + 8
End If
If GetNextTurret = 8 Then
GetNextTurret = 1
Else
GetNextTurret = GetNextTurret + 1
End If
End Function
regards Thomas
3, ... ive had enough of this product!
Sub Main()
' -------------------------------------------------------------------------------
' TPS 09.10.2015
' simple Test for Toolchange
' -------------------------------------------------------------------------------
' pin2 is mapped to Input1
' pin3 is mapped to Input2
' pin4 is mapped to Input3
' pin5 is mapped to Input4
' charger seated is mapped to OEMTRIG1
'get the new tool ---------------------------------------------------------------
tool = GetSelectedTool()
' nothing to do
If GetSelectedTool() = GetCurrentTool() Then
message("Tool is the same NO tool change needed")
End
End If
If tool > 8 Or tool < 1 Then 'check tool number to be in range
Message (" Tool " & tool & " is not a valid Number 1-8 ONLY, ENDING Program RUN ")
DoButton(3)
End
End If
Dim ActTurretPos As Long
ActTurretPos = 0
'get actual starttime
Starttime = Timer
Message "Moving to Tool# " &GetselectedTool()
tryagain:
ActivateSignal(output5) 'unlocks stop dog
Sleep(1000) 'wait for a second
ActivateSignal(OutPut6) 'turn air motor on
While ActTurretPos <> tool 'turn until we are in the wright position
ActTurretPos = GetTurret()
'give the other inputs a chance
If ActTurretPos <> 0 Then
Sleep(50)
ActTurretPos = GetTurret() 'read Turretpos again
End if
Akttime = Timer
If Akttime - Starttime > 20 Then 'Timeout 20s
Message("Turret timeout")
DeActivateSignal(output5) 'locks stop dog
Sleep(1000) 'wait for a second
DeActivateSignal(OutPut6) 'turn air motor off
End
End If
Wend
DeActivateSignal(output5) 'locks stop dog
Sleep(1000) 'wait for a second
DeActivateSignal(OutPut6) 'turn air motor off
sleep(1000)
'recheck the turretpos and retry
If tool <> 8 then
If (GetTurret()-1) <> tool then ' from tool is 1-7 toolno -1
goto tryagain
End If
Else
If GetTurret() <> 1 then ' if tool = 8 then turretpos must be 1
goto tryagain
End If
End If
'look for OEMTRIG1
If Not IsActive(OEMTRIG1) Then
DOButton(3)
MsgBox("Tool changer not seated!")
End
End If
Message("Tool " & tool & " Loaded")
SetCurrentTool( tool )
End Sub
'function to get the actual turret positiom
Function GetTurret() As Long
GetTurret = 0
If IsActive(Input1) Then
GetTurret = GetTurret + 1
End If
If IsActive(Input2) Then
GetTurret = GetTurret + 2
End If
If IsActive(Input3) Then
GetTurret = GetTurret + 4
End If
If IsActive(Input4) Then
GetTurret = GetTurret + 8
End If
End Function
Sub Main()
' -------------------------------------------------------------------------------
' TPS 09.10.2015
' simple Test for Toolchange
' -------------------------------------------------------------------------------
' pin2 is mapped to Input1
' pin3 is mapped to Input2
' pin4 is mapped to Input3
' pin5 is mapped to Input4
' charger seated is mapped to OEMTRIG1
'get the new tool ---------------------------------------------------------------
tool = GetSelectedTool()
' nothing to do
If GetSelectedTool() = GetCurrentTool() Then
message("Tool is the same NO tool change needed")
End
End If
If tool > 8 Or tool < 1 Then 'check tool number to be in range
Message (" Tool " & tool & " is not a valid Number 1-8 ONLY, ENDING Program RUN ")
DoButton(3)
End
End If
Dim ActTurretPos As Long
ActTurretPos = 0
'get actual starttime
Starttime = Timer
Message "Moving to Tool# " &GetselectedTool()
tryagain:
ActivateSignal(output5) 'unlocks stop dog
Sleep(1000) 'wait for a second
ActivateSignal(OutPut6) 'turn air motor on
While ActTurretPos <> tool 'turn until we are in the wright position
ActTurretPos = GetTurret()
'give the other inputs a chance
If ActTurretPos <> 0 Then
Sleep(50)
ActTurretPos = GetTurret() 'read Turretpos again
End if
Akttime = Timer
If Akttime - Starttime > 20 Then 'Timeout 20s
Message("Turret timeout")
DeActivateSignal(output5) 'locks stop dog
Sleep(1000) 'wait for a second
DeActivateSignal(OutPut6) 'turn air motor off
End
End If
Wend
DeActivateSignal(output5) 'locks stop dog
Sleep(1000) 'wait for a second
DeActivateSignal(OutPut6) 'turn air motor off
sleep(1000)
'recheck the turretpos and retry
If (GetTurret()-1) <> tool then
goto tryagain
End If
'look for OEMTRIG1
If Not IsActive(OEMTRIG1) Then
DOButton(3)
MsgBox("Tool changer not seated!")
End
End If
Message("Tool " & tool & " Loaded")
SetCurrentTool( tool )
End Sub
'function to get the actual turret positiom
Function GetTurret() As Long
GetTurret = 0
If IsActive(Input1) Then
GetTurret = GetTurret + 1
End If
If IsActive(Input2) Then
GetTurret = GetTurret + 2
End If
If IsActive(Input3) Then
GetTurret = GetTurret + 4
End If
If IsActive(Input4) Then
GetTurret = GetTurret + 8
End If
End Function