Szerszám bemérés kézi szerszámcsere után

Az alábbi szkript a legegyszerűbb megoldást nyújtja a szerszám bemérésére.
Önálló makróként, vagy a képernyő erre a célra szánt gombja alá másolva is működtethető.
A bemérő méretét figyelembe véve a Z DRO értékét írja át. A pontos eredményhez a szkripten belül a Ph változó értékét az adott eszköz magasságával megegyező értékkel kell kitölteni!

Használat:
- A bemérő fölé kell állni 5-25 milliméterrel. (Az érték a ToGo változó értékének módosításával változtatható.)
- Makróval vagy gombbal indítható a bemérés.
- Ha a megadott távon belül a bemérő jelet ad a Mach3 felé, akkor 5 milliméter visszaemelés után kis előtolással a ráközelítést megismétli és a Z DRO beállítását elvégzi a szkript.
- Ha nem éri el a bemérőt (nem jut jel a Mach3-hoz, akkor nem módosítja a Z értéket, bemérés nem történik meg.
(A bemérés sikerességéről a státusz ablakban tájékoztató szöveg jelenik meg.)

Kód:

'Szerszámhossz bemérés kézi szerszámcseréhez, mm verzió
'A bemérés során a Z DRO kerül átírásra

Sub Main

Dim Ph
Dim ToGo
Dim ZProbePos
Dim Up


'Ezt a két változót be kell állítani!
Ph= 20 'Bemérő eszköz magassága
Up= 20 'Felemelés mérés után növekményesen

If IsSuchSignal(22)=0 Then  'Probe bemenet engedélyezésének ellenőrzése
  Code "(Nincs Bemérő bemenet definiálva!)"
  Exit Sub
End If


If GetOemLed (825)=0 Then 'Ha a tapintó még nem aktív

  SetScale(2,1) 'Z scale legyen 1
  Code "G90"
        
  ToGo = GetDRO(2)-30 'Kezdő pozícióból elérendőt számol
  
  Code "G31 Z" & ToGo & "F400" 'Durva bemérés
    Wait
  Code "G91 G1 Z5 F800"  ' Tapintótól elemelés
    Wait
  Code "G90 G31 Z" & ToGo & "F25" 'Finom  bemérés
    Wait
 
  ZProbePos = GetVar(2002) 'Mért koordináta kiolvasása
    Code "G1 Z" & ZProbePos  'Vissza a mért pontra
    Wait

  If ZProbePos <> ToGo Then ' Ha elérte a bemérőt a szerszám  
   SetDRO(2,Ph) 'Z DRO átírása
   Code "G91G0Z" & Up 'Z Felemelése
   Wait    
     Code "(T" & GetOEMDRO(824) & " hossza bemérve!)"
     Code "G90"
    
  Else 'Nem érte el a bemérőt
     Code "( Szerszám nincs bemérve! )"
  End If
  
Else
  Code "(Bemérő már aktív! Ellenőrizd és próbáld újra!)"
  Exit Sub
  
End If

End Sub

Sub Wait

  While IsMoving ()
    Sleep(100)
  Wend

End Sub