Good morning
having time I am fixing my screenset, I have this macro internal external center that works well (taken from the network and modified to my needs) the only problem is that with the scan "A" ("TO EXTERNAL CENTER") the positioning takes place at maximum speed, then for the touch it works well, is it possible to change it by setting the positioning speed? is there anyone who can encourage me to correct it? I thank those who can help me
ps: the inner part ("B INTERNAL CENTER") works fine.
' CENTRO INTERNO ESTERNO
Sub Main
If (GetOEMLED(800)) Then
Message ("ERRORE : MACCHINA IN EMERGENZA ")
Speak ("errore macchina in emergenza") 'Avviso Vocale
Exit Function
End If
Speak (" CENTRO INTERNO ESTERNO") 'Avviso Vocale
Begin Dialog SelectCentering 250,40,150,270,"SELEZIONA CENTRO"
OKButton 20,245,40,15
CancelButton 90,245,40,15
GroupBox 10,5,130,57,"CENTRATURA",.GroupBox1
Picture 5, 95, 140, 140, "c:\mach3\addons\centri_scan_sondaggi\bitmaps\centro A.bmp"
text 15,68,180,8, " PS: PER LA SCANSIONE ESTERNA "
text 12,78,180,8, "POSIZIONARSI 5 MM SOPRA IL PEZZO"
OptionGroup .OptionGroup1
OptionButton 30,18,100,8,"A CENTRO ESTERNO",.OptionButton1
OptionButton 30,49,100,8,"B CENTRO INTERNO" ,.OptionButton2
TextBox 20,30,50,12,.TextBox1
Text 75,31,50,8,"LUNGHEZZA"
End Dialog
Dim Dlg1 As SelectCentering
Button = Dialog (Dlg1)
lunghezza = CDbl(Dlg1.TextBox1)
SetOEMDRO 1824 , lunghezza
If Button = 0 Then Exit Sub
Selected = Dlg1.OptionGroup1
'CENTRO pezzo pieno is selected @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
If Selected = 0 Then
Speak (" CENTRO PEZZO PIENO") 'Avviso Vocale
Tasto = MsgBox("CONFERMARE CENTRO PEZZO PIENO" ,1+64, "CONFERMARE")
If Tasto <> 1 Then
Exit Sub
End If
Sleep (500) ' pausa di 1 secondi
Message "**** zero assi ****"
DoOEMButton (1008) 'zero X
DoOEMButton (1009) 'zero Y
DoOEMButton (1010) 'zero Z
Call SetOEMDRO(1826,0)
Speak ("ZERO assi completato") 'Avviso Vocale
'CurrentFeed = GetOemDRO(818) 'Get the current feedrate to return to later
CurrentFeed = GetOemDRO(818) 'Get the current feedrate to return to later
CurrentAbsInc = GetOemLED(48) 'Get the current G90/G91 state
CurrentGmode = GetOemDRO(819) 'Get the current G0/G1 state
CurrentToolDiameter = GetOemDRO(1000) 'gets the current tool diameter
If GetOemLed (825) <> 0 Then 'Check to see if the probe is already grounded or faulty
Call ProbeGrounded()
Exit Sub
Else
Sleep (1500) ' pausa di 1 secondi
XCurrent = GetDro(0)
YCurrent = GetDro(1)
' OutsideDiameter = QUESTION ("DIAMETRO APPROSSIMATIVO")
OutsideDiameter = GETOEMDRO(1824) ' leggi F di Spostamento
Message "**** RICERCA ****"
Code "G4 P1" 'Pause 1 second to give time to position probe plate
While IsMoving ()
Sleep(100)
Wend
Call SetDro (0,0.000)
While IsMoving ()
Sleep(100)
Wend
Call SetDro (1,0.000)
Code "F50" 'slow feed rate to 100mm/sec
Code "G90 G0 X" &XNew + OutsideDiameter * .6
Code "G91 G0 Z-10"
Rem Probe Left
XNew = Xcurrent - 75
Code "G31 X" &XNew
While IsMoving() 'wait for the move to finish
Sleep(100)
Wend
Code "G91 G0 X1 F10"
While IsMoving() 'wait for the move to finish
Sleep(100)
Wend
Code "G31 X" &XNew
While IsMoving() 'wait for the move to finish
Sleep(100)
Wend
XPos1 = GetVar(2000) 'get the probe touch location
Code "G91 G0 X1 F50"
Code "G91 G0 Z10"
Code "G90 G0 X" &XCurrent 'rapid move back to start point
Code "G91 G0 X" &XCurrent - OutsideDiameter * .6
Code "G91 G0 Z-10"
Rem Probe Right
XNew = XCurrent + 75 'probe 75mm to right
Code "G31 X" &XNew
While IsMoving()
Sleep(100)
Wend
Code "G91 G0 X-1 F10"
While IsMoving() 'wait for the move to finish
Sleep(100)
Wend
Code "G31 X" &XNew
While IsMoving() 'wait for the move to finish
Sleep(100)
Wend
XPos2 = GetVar(2000)
Code "G91 G0 X-1 F50"
Code "G91 G0 Z10"
XCenter = (XPos1 + XPos2) / 2 'center is midway between XPos1 and XPos2
Code "G90 G0 X" &XCenter 'rapid move to the x center location
While IsMoving ()
Sleep(100)
Wend
Call SetDro (0,0.000)
Code "G4 P0.25"
Code "G90 G0 Y" &YNew - OutsideDiameter * .6
Code "G91 G0 Z-10"
Rem Probe up
YNew = YCurrent + 75
Code "G31 Y" &YNew
While IsMoving()
Sleep(100)
Wend
Code "G91 G0 Y-1 F10"
While IsMoving() 'wait for the move to finish
Sleep(100)
Wend
Code "G31 Y" &YNew
While IsMoving() 'wait for the move to finish
Sleep(100)
Wend
YPos1 = GetVar(2001)
Code "G91 G0 Y-1 F50"
Code "G91 G0 Z10"
Code "G90 G0 Y" &YCurrent
Code "G91 G0 Y" &YCurrent + OutsideDiameter * .6
Code "G91 G0 Z-10"
Rem Probe down
YNew = YCurrent - 75
Code "G31 Y" &YNew
While IsMoving()
Sleep(100)
Wend
Code "G91 G0 Y1 F10"
While IsMoving() 'wait for the move to finish
Sleep(100)
Wend
Code "G31 Y" &YNew
While IsMoving() 'wait for the move to finish
Sleep(100)
Wend
YPos2 = GetVar(2001)
Code "G91 G0 Y1 F50"
Code "G91 G0 Z10"
YCenter = (YPos1 + YPos2) / 2
Rem move To the center
Code "G90 G0 Y" &YCenter
While IsMoving ()
Sleep(100)
Wend
Call SetDro (1,0.000)
While IsMoving ()
Sleep(100)
Wend
Call SetUserDro (1826,YPos2 - YPos1 - CurrentToolDiameter)
Message "**** RICERCA COMPLETATA ****"
Code "G4 P0.25"
Code "F" &CurrentFeed 'restore starting feed rate
Call ReturnG90G91State()
Exit Sub
End If
End If
'CENTRO PEZZO INTERNO is selected@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
If Selected = 1 Then
Speak (" RICERCA CENTRO INTERNO") 'Avviso Vocale
Tasto = MsgBox("CENTRO INTERNO" ,1+64, "CONFERMARE")
If Tasto <> 1 Then
Exit Sub
End If
'(M1055) Center Of Circle With Diamter
Message "****** CENTRO FORO ******"
Message "**** zero assi ****"
DoOEMButton (1008) 'zero X
DoOEMButton (1009) 'zero Y
DoOEMButton (1010) 'zero Z
Call SetOEMDRO(1826,0)
Sleep (1000)
setvar(2000,0)
setvar(2001,0)
setvar(1,0)
setvar(2,0)
setvar(3,0)
setvar(4,0)
setvar(5,0)
setvar(6,0)
setvar(7,0)
setvar(8,0)
Setvar(9,0)
tmc=getoemdro(221)
setvar(9,(tmc/2))
Code "G91"
Code "G31X-70 F200"
While Ismoving()
Sleep(100)
Wend
Code"G1x5"
Code"#1=#2000"
Code"G31x140 F200"
While Ismoving()
Sleep(100)
Wend
Code"#2 =#2000"
Code"#3=[#1-#2]"
code"#7=[#3/2]"
Code"G1x[#7+#9]"
Code"G31Y70 F200"
While Ismoving()
Sleep(100)
Wend
Code"#4=#2001"
Code"G1y-.5"
Code"G31y-140 F200"
While ISmoving()
Sleep(100)
Wend
Code"#5 =#2001"
Code"#6 =[#4-#5]"
code"#8 =[#6/2]"
Code"G1y[#8-#9]"
While Ismoving()
Sleep(100)
Wend
Code"G90 M30"
HD= Getvar(6)
Call SetUserDro (1826, HD + GetOemDRO (1000))
'MsgBox ("Hole Diameter is " & HD + GetOemDRO (1000))
End If
End Sub
Sub ProbeGrounded()
Code "(Probe plate is grounded, check connection and try again)"
Call ReturnG90G91State()
End Sub
Sub ReturnG90G91State()
If CurrentAbsInc = 0 Then 'if G91 was in effect before then return to it
Code "G91"
End If
If CurrentGMode = 0 Then 'if G0 was in effect before then return to it
Code "G0"
End If
End Sub