'OTOMATİK TAKIM DEĞİŞTİRME MAKROSU
'İzzet Mehmet KÖSE ve Ramertürk (Mustafa Abi)
'[B]Farklı Z seviyelerindeki tool için ATC makrosu[/B]
Public xtool As Integer
Public Ytool As Integer
Public ToolDown As Integer
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 = 16 '*** Değiştirmek istenen max. takım sayısı
ToolDown = 20 '*** Takımı almak yada bırakmak için Z nin pozisyonu...! Her tool icin ayrı olabilir.
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" & ToolDown
While IsMoving()
Wend
Call ToolPos(OldTool)
Code "G53 X" & XTool & " Y" & YTool
While IsMoving()
Wend
'************** Yeni takım alınıyor ******************************
Call ToolPos(NewTool)
Code "G53 X" & XTool & " Y" & YTool
While IsMoving()
Wend
'************* Tool numarası set ediliyor ***********************
Call SetUserDRO (1200,NewTool)
SetCurrentTool( NewTool )
' Tell the user to load the requested tool
Speak("Please insert tool number " & " ( " & GetCurrentTool() & " ) click ok When Ready")
Code "M00"
' Verify Tool Change Complete message box
Dim Msg, Style, Title, Help, Ctxt, Response,MyString
Msg = "Please Insert Tool Number " & " ( " & GetCurrentTool() & " ) "
'Msg = "Please Insert Tool Number " & " ( " & GetSelectedTool() & " ) " ' Define message
Style = vbYesNo + vbCritical + vbDefaultButton2 ' Define buttons
Style = 0 + 48 + 0 ' Define buttons.
Title = "Tool Change Requested" ' Define title
Help = "DEMO.HLP" ' Define Help file
Ctxt = 1000 ' Define topic
'context.
' Display message.
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbOk Then ' User chose Ok
MyString = "Ok" ' Perform some action
End If
' Tell the user to load the requested tool
Speak("tool number " & " ( " & GetCurrentTool() & " ) " & " ) Installed Returning to Tool Change Start position")
Code "M00"
'Show user the current tool description
Message "Tool # " & GetCurrentTool() & " : Installed " & " Returning To Tool Change Start Position"
' Tell the user to Press cycle start
Speak("Tool Change complete")
Code "M00"
Speak("Press Cycle Start")
Code "M00"
'************ Otomatik Takım Sıfırlama******************* (Gökhan abimizin paylaşmış olduğu takım sıfırlama macrosudur)
PlateThickness = GetUserDRO(1151)
If GetOemLed (825)=0 Then
DoOEMButton (1010)
Code "G4 P1" 'P1 değeriyle oynayabilirsiniz. Amacı auto tool zero tuşuna bastığınızda harekete geçmek için ne kadar süre beklemesi gerektiğidir. Mesela acelem var derseniz 0.25 yapabilirsiniz:) Yalnız nokta ile virgül değil
Code "G53 G0 Z15 X15 Y15" 'Takım sıfırlama sensörünün kordinatları buraya yazılacak
Code "G31 Z0 F500" '0 değeri Z eksenininsıfırlama yapmak için en fazla ne kadar ineceğinin sınırıdır. Mesela Auto tool zero dedeniz ve Z inmeye başladı. 0 birimde probu göremezse işlem iptal :) F500 ise bildiginiz gibi iniş hızınız. Düşürmekte fayda var.
While IsMoving()
Wend
ZProbePos = GetVar(2002)
Code "G0 Z" &ZProbePos
While IsMoving ()
Wend
Call SetDro (2, ProbKalınlığı) 'Buraya virgülden sonra boşluk bırakarak probunuzun kalınlığını giriniz. Mesela 10.5 gibi. Onluk ayıracının Nokta olmasına dikkat)
Code "G4 P0.25" 'Buradaki P değeri sıfırlama işlemi bittikten sonra Z ekseninin alt satıra yazacağımız değere kalkarak ne kadar süreyle beklemede kalacağıdır.
Code "G0 Z20" '20 değeri Z nin probu gördükten sonra ne kadar yükseğe kalkması gerektiğidir
Code "(Z ekseni sıfırlandı...)" 'Buraya sıfırmala işlemi sonrasında Mach3 Statüs barında yazmasını istediğiniz mesajı yazacaksınız.
Else
Code "(Z Eksen Sıfırlama Hatası... Bağlantıları kontrol ederek tekrar deneyiniz...)" 'Anlaşılacağı üzere hata durumunda mesajınız
Code "G00 X" & x & " Y" & y '*** Takım değiştirmeyi tamamlayıp kaldığı yere konumlanma....
Exit Sub
End If
End Sub
'*********** Takım konumlnma alt fonksiyonu Takım yerleri burda belirtilir. ************
'Xtool: Toolun X değeri Ytool: Toolun Y değeri.
'Tool hangi eksende ise ona göre değerleri değiştirmek gerekir.
Sub ToolPos(ByVal ToolNumber As Integer)
Select Case ToolNumber
Case Is = 1
XTool = 20
YTool = 20
ToolDown = 20
Case Is = 2
XTool = 20
YTool = 20
ToolDown = 20
Case Is = 3
XTool = 20
YTool = 20
ToolDown = 20
Case Is = 4
XTool = 20
YTool = 20
ToolDown = 20
Case Is = 5
XTool = 20
YTool = 20
ToolDown = 20
Case Is = 6
XTool = 20
YTool = 20
ToolDown = 20
Case Is = 7
XTool = 20
YTool = 20
ToolDown = 20
Case Is = 8
XTool = 20
YTool = 20
ToolDown = 20
Case Is = 9
XTool = 20
YTool = 20
ToolDown = 20
Case Is = 10
XTool = 20
YTool = 20
ToolDown = 20
Case Is = 11
XTool = 20
YTool = 20
ToolDown = 20
Case Is = 12
XTool = 20
YTool = 20
ToolDown = 20
Case Is = 13
XTool = 20
YTool = 20
ToolDown = 20
Case Is = 14
XTool = 20
YTool = 20
ToolDown = 20
Case Is = 15
XTool = 20
YTool = 20
ToolDown = 20
Case Is = 16
XTool = 20
YTool = 20
ToolDown = 20
End Select
End Sub
Main
eve geçince izah edeyim detaylı olarak
