' OTOMATİK TAKIM DEĞİŞTİRME MAKROSU' Mehmet İzzet KÖSE
Sub Main()
OldTool = GetOEMDRO (1200)
x = GetToolChangeStart( 0 )
y = GetToolChangeStart( 1 )
z = GetToolChangeStart( 2 )
a = GetToolChangeStart( 3 )
b = GetToolChangeStart( 4 )
c = GetToolChangeStart( 5 )
tool = GetSelectedTool()
NewTool = tool
MaxToolNum = 8 '*** Değiştirmek istenen max. takım sayısı
ToolDown = 2 '*** Takımı almak yada bırakmak için Z nin pozisyonu...!
ToolUp = 5 '*** Bıraktığı takımdan alacağı takıma giderken Z nin pozisyonu...!
If NewTool = OldTool Then
Exit Sub
End If
While NewTool > MaxToolNum
NewTool = Question ("Enter New Tool Number up to " & MaxToolNum)
Wend
'*************** Eski takım bırakılıyor *************************
Code "G00 G53 Z" & ToolUp
While IsMoving()
Wend
Call MovePos(OldTool)
While IsMoving()
Wend
Code "G53 Z" & ToolDown
Code "G4 P.75"
While IsMoving()
Wend
ActivateSignal(Output1) '*** Takımı bırakmak için gerekli sinyal....!
Code "G4 P1.0" '*** Takımı bırakmak için bekletmek... gerektiği kadar gecikme yaptırılır...!
'SystemWaitFor (7) 'Takımı aldığını bildiren Limit switch sinyalini beklemek...opsiyoneldir.. istenirse kullanılmaz... şuan pasif durumda gerekirse satır başındaki tırnağı kaldırmak yeterli...
Code "G53 Z" & ToolUp
'*********** Yeni takım alınıyor ***********
Call MovePos(NewTool)
While IsMoving()
Wend
Code "G53 Z" & ToolDown
Code "G4 P.75"
While IsMoving()
Wend
DeActivateSignal(Output1) '*** Takımı bırakmak için gönderilen sinyali kapatıyor, yani takımı tutuyor.
Code "G4 P1.0" '*** Wait for the tool to Clamp
While IsMoving()
Wend
Code "G53 Z" & ToolUp
'---- Yeni tool numarası set ediliyor -------
Call SetUserDRO (1200,NewTool)
SetCurrentTool( NewTool )
Code "G00 X" & x & " Y" & y '*** Takım değiştirmeyi tamamlayıp kaldığı yere konumlanma....
End Sub
'*********** Takım konumlnma alt fonksiyonu ************
Sub MovePos(ByVal ToolNumber As Integer)
If (Toolnumber>=1) And (Toolnumber<=8) Then
xpos = (toolnumber * 25) + 10
ypos = 4
' 25 : Takımlar arasındaki sabit mesafe
' 10 : Takım balangiç poz.
Else
xpos=x
ypos=y
End If
Code "G53 X" & XPos & " Y" & YPos
End Sub
Main