Topics

1

VB and the development of wizards / macro fix help

« on: February 20, 2024, 06:00:25 AM »

Good morning
I found a macro on the net, I adapted it to my needs, from the tests I did it seems to work, but since it is not within my capabilities I would like to be sure of its functioning without having problems. I wonder if someone (much more capable than me) could check it for me and possibly correct it.
I thank anyone who can help me. Regards

Code: [Select]

Sub Main()
Dim Title As String
Begin Dialog TextBoxSample 250,15,180,335," RICERCA ANGOLO  > "
Picture 25, 5, 130, 130, "c:\mach3\bitmaps\Ita_Screenset\ANGOLO2.bmp"
OKButton 30,312,40,15
CancelButton 100,312,40,15
  GroupBox 5,140,170,165,"-- RICERCA ANGOLO",.GroupBox1 
TextBox 15,160,25,12,.XPlateWidth
   Text 45,162,128,8,"SPESSORE PIASTRA LATERALE X"                
TextBox 15,178,25,12,.YPlateWidth
   Text 45,180,128,8,"SPESSORE PIASTRA LATERALE Y"                                    
TextBox 15,196,25,12,.Xrepos
   Text 45,198,125,8,"SPOSTAMENTO LATERALE X"              
TextBox 15,214,25,12,.Yrepos
   Text 45,216,125,8,"SPOSTAMENTO LATERALE Y"              
TextBox 15,232,25,12,.PlateHeight
   Text 45,234,128,8,"ALTEZZA PIASTRA "              
TextBox 15,250,25,12,.ProbeDiameter
   Text 45,252,80,8,"DIAMETRO PROBE"
   Text 55,272,80,8,"###   VELOCITA'   ###"            
TextBox 15,288,25,12,.Velo
   Text 42,290,110,8,"<--  VELOCE        PIANO  -->"        
TextBox 140,288,25,12,.Pian    
  End Dialog
Dim Dlg1 As TextBoxSample
'Default Settings
  Dlg1.Xrepos = 25     'Distanza per spostare X- prima di spostarsi verso il basso per la sonda
Dlg1.Yrepos = 25     'Distanza per spostare X- prima di spostarsi verso il basso per la sonda
Dlg1.XPlateWidth = 0    'SPESSORE LATERALE X
Dlg1.YPlateWidth = 0    'SPESSORE LATERALE Y
Dlg1.PlateHeight = 5 'ALTEZZA PIASTRA
Dlg1.ProbeDiameter = 3.0 'DIAMETRO PROBE
Dlg1.velo = 150          'VELOCITA' VELOCE
Dlg1.Pian = 40        'VELOCITA' PIANO

Button = Dialog (Dlg1)
If Button = 0 Then Exit Sub
Xrepos = Val(Dlg1.Xrepos)
Yrepos = Val(Dlg1.Yrepos)
XPlateWidth = Val(Dlg1.XPlateWidth)
YPlateWidth = Val(Dlg1.YPlateWidth)
PlateHeight = Val(Dlg1.PlateHeight)
ProbeDiameter = Val(Dlg1.ProbeDiameter)
velo = Val(Dlg1.velo)
Pian = Val(Dlg1.Pian)

Cutter_Size = ProbeDiameter
Cutter_Size2 = Cutter_Size/2

Plate_X_Offset = XPlateWidth
Plate_Y_Offset = YPlateWidth
Plate_Z_Offset = 0

Plate_X_Offset1 = -1*(Plate_X_Offset+Cutter_Size2)
Plate_Y_Offset1 = -1*(Plate_Y_Offset+Cutter_Size2)

Message( "Probing routine initialized" )

If IsSuchSignal (22) Then
SetDRO(0,0) 'set X DRO a Zero
SetDRO(1,0) 'set Y DRO a Zero
SetDRO(2,0) 'set Z DRO a Zero
Sleep 10
code "G90"

'Z Probing
code "G31 Z-30 F" & velo
While IsMoving()
Wend
Sleep 50
code "G0 G91 Z1"
While IsMoving()
Wend
code "G31 Z-10 F" & Pian
While IsMoving()
Wend
ZProbePos = GetOEMDRO(802)
code "G90"
code "G0 Z" &ZProbePos
While IsMoving()
Wend
Call SetDro(2, Plate_Z_Offset)
Sleep 100
code "G0 Z5"
End If

'Y Probing
If IsSuchSignal (22) Then
code "G0 Y-" & Yrepos
code "G0 Z-8"
code "G31 Y5 F" & velo
While IsMoving()
Wend
Sleep 50
code "G0 G91 Y-3"
While IsMoving()
Wend
code "G31 Y5 F" & Pian
While IsMoving()
Wend
YProbePos = GetOEMDRO(801)
code "G90"
code "G0 Y" &YProbePos
While IsMoving()
Wend
Call SetDro(1, Plate_Y_Offset1)
Sleep 100
code "G0 Y-18"
code "G0 Z5"
code "G0 Y10"
End If

'X Probing
If IsSuchSignal (22) Then
code "G0 X-" & Xrepos
code "G0 Z-8"
code "G31 X5 F" & velo
While IsMoving()
Wend
Sleep 50
code "G0 G91 X-3"
While IsMoving()
Wend
code "G31 X5 F" & Pian
While IsMoving()
Wend
XProbePos = GetOEMDRO(800)
code "G90"
code "G0 X" &XProbePos
While IsMoving()
Wend
Call SetDro(0, Plate_X_Offset1)
Sleep 100
code "G0 X-18"
code "G0 Z10"
End If

Sleep 100

code "G0 X0.0"
code "G0 Y0.0"

While IsMoving()
Wend
z=GetOEMDRO(802)
z=Z+PlateHeight
SetOEMDRO(802,z)
Message( "Probing routine complete" )

End Sub

2

General Mach Discussion / delay the start of processing

« on: February 12, 2024, 12:51:29 PM »

Good morning
I would like to delay the processing after turning on the spindle (m3) to give it time to reach the spindle revolutions. I tried in " config \port and pins\spindle setup\cv delay spin up and cw delay spin down) to insert various values from 1 to 10 but nothing changes
I'll start by saying that I use UC400ETH, Windows XP everything else works fine, is it possible to modify M3, any ideas/suggestions?
any advice is welcome.

3

VB and the development of wizards / center piece modification

« on: December 30, 2023, 06:51:21 AM »

Good morning
I found this macro on the net (JIM TAYLOR) for the center of the piece and it works well (for me) I tried to modify it to insert the parameters, I also used " #5= question......" but it doesn't work (don't laugh !!!!), if possible I would like to use a screen to enter the data, since it is not in my skills (I understand very little about programming) is there any soul who can help me?

Code: [Select]


;Set the monitor variables to zero
#1=0
#2=0
#3=0
#4=0

#5=180 (X-rh)
#6=0 (X-lh)
#7=200 (Y-top)
#8=0 (Y-bot)
#9=0 (good x-ctr)
#10=0 (good Y-ctr)
#17=0 (Z-ref)
#18=4 (edge clearances)

#11=[[#5-#6]/2] (nominal X-value of block center)
#12=[[#7-#8]/2] (nominal Y-value of block center)
#13=-3.5 (some Z-value below the block surface)
#14=3 (probe tip radius)

#15=[#5-#6] (nominal width X-dir)
#16=[#7-#8] (nominal height Y-dir)

;move to nominal block center
G0 X#11 Y#12 (move to nominal block center)
G31 Z-50 f50 (probe Z-ref)
G0 Z[#2002+2] (move above block)
#17=#2002

;probe +X side of block
g0 X[#11+#15/2+#14+#18] (move past +X-edge)
g0 Z[#13+#17] (descend below surface)
G31 X[#11 - #15] (probe +X side of block)
#5=[#2000-#14]     (RH edge)
g0 Z[#17+2]

;move to nominal block center
G0 X#11 Y#12 (move to nominal block center)

;probe -X side of block
g0 X[#11-#15/2-#14-#18] (move past -X-edge)
g0 Z[#13+#17] (descend below surface)
G31 X[#11 + #15] (probe -X side of hole)
#6=[#2000+#14]     (LH edge)
#9=[[#5 + #6] / 2.0]    (good X-block center)
g0 z[#17+2]
#1=[#5-#6] (+RH edge + -LH edge - +tool dia = Xwidth)

;################################################

;move to nominal block center
G0 X#9 Y#12 (back to center of block)

;probe +Y side of block
g0 Y[#12+#16/2+#14+#18] (move past +Y-edge)
g0 Z[#13+#17] (descend below surface)
G31 Y[#12 - #16]
#7=[#2001-#14]     (Top edge)
g0 Z[#17+2]

;move to nominal block center
G0 X#9 Y#12 (back to center of block)

;probe +Y side of block
g0 Y[#12-#16/2-#14-#18] (move past -Y-edge)
g0 Z[#13+#17] (descend below surface)
G31 Y[#12 + #16] (probe -Y side of block)
#8=[#2001+#14]     (Bot edge)
#10=[[#7 + #8] / 2.0]                           (good Y-value block center)
g0 Z[#17+2]
#2=[#7-#8] (Top edge - Bot edge - tool dia = Yheight)

g0 x#9 y#10 (go to XYctr)
M30

4

VB and the development of wizards / DRO reading

« on: December 04, 2023, 11:41:09 AM »

Good evening
having the need to see the read the dro in the bar
I put the following line in the script:
Message "X = " & GetOemDRO(800)
it works fine, but in the display it gives me a series of numbers
after the point, I'll try to explain better if the value of the dro is
"77,340"
in the bar I see:
"77.340000001242"
I ask anyone who is capable (since I am not) if it is possible to shorten the figures e.g.: 77,340.
I thank anyone who can help me
Greetings

5

VB and the development of wizards / virtual keyboard

« on: December 03, 2023, 04:47:08 AM »

Good morning
I have a problem with this virtual keyboard connected to the network (TPS),
the problem is the following:
I insert (in the same line) x37.22 y22.
here comes the problem at the second point comes out and moves the cnc
Since it's not within my capabilities and skills, is there anyone who can correct it?
I thank anyone who can help me
Greetings

  Global value As String

'TPS 01.12.2017
'numerische Eingabe
Function NumericKeyboard(ByVal DRONum As Integer) As Double
   Dim title As String
   'value = GetOemDRO(DRONum)
   title = Header
   
   
   Begin Dialog UserDialog1 60,60, 195, 180, "Input:"  , .Enable
   
      PushButton 10, 10, 25, 25, "7", .but7
      PushButton 40, 10, 25, 25, "8", .but8
      PushButton 70, 10, 25, 25, "9", .but9

      PushButton 10, 40, 25, 25, "4", .but4
      PushButton 40, 40, 25, 25, "5", .but5
      PushButton 70, 40, 25, 25, "6", .but6
      
      PushButton 10, 70, 25, 25, "1", .but1
      PushButton 40, 70, 25, 25, "2", .but2
      PushButton 70, 70, 25, 25, "3", .but3

      PushButton 10, 100, 25, 25, ".", .butD
      PushButton 40, 100, 25, 25, "0", .but0
      PushButton 70, 100, 25, 25, "<-", .butB

      PushButton 100, 10, 25, 25, "X", .butX
      PushButton 100, 40, 25, 25, "Y", .butY
      PushButton 100, 70, 25, 25, "Z", .butZ
      PushButton 100, 100, 25, 25, "A", .butA

      PushButton 130, 10, 25, 25, "F", .butF
      PushButton 130, 40, 25, 25, "S", .butS
      PushButton 130, 70, 25, 25, "M", .butM
      PushButton 130, 100, 25, 25, "Sp", .butSp

      PushButton 160, 10, 25, 25, "G", .butG

      TextBox 10, 130, 175, 18, .FText
      PushButton 10, 155, 40, 21,"OK", .OK
      CancelButton 55, 155, 40, 21
   End Dialog


   Dim Dlg1 As UserDialog1

   'Dlg1.FText = CStr(value)
   Dlg1.FText = ""
   x = Dialog( Dlg1 )

   'NumericKeyboard = CDbl(Dlg1.FText)
   If x <> 0 Then
      'SetOEMDro(DRONum,CDbl(Dlg1.FText))
      Code Dlg1.FText
   End If      
End Function

Function Enable( ControlID$, Action%, SuppValue%)

   Select Case Action%
      Case 1
         
      Case 2 'Button wurde gerückt
         If ControlID$ = "but0" Then
            value = CStr(value) + "0"
            DlgText "FText", CStr(value)
            Enable =1
         End If
         If ControlID$ = "but1" Then
            value = CStr(value) + "1"
            DlgText "FText", CStr(value)
            Enable =1
         End If
         If ControlID$ = "but2" Then
            value = CStr(value) + "2"
            DlgText "FText", CStr(value)
            Enable =1
         End If
         If ControlID$ = "but3" Then
            value = CStr(value) + "3"
            DlgText "FText", CStr(value)
            Enable =1
         End If
         If ControlID$ = "but4" Then
            value = CStr(value) + "4"
            DlgText "FText", CStr(value)
            Enable =1
         End If
         If ControlID$ = "but5" Then
            value = CStr(value) + "5"
            DlgText "FText", CStr(value)
            Enable =1
         End If
         If ControlID$ = "but6" Then
            value = CStr(value) + "6"
            DlgText "FText", CStr(value)
            Enable =1
         End If
         If ControlID$ = "but7" Then
            value = CStr(value) + "7"
            DlgText "FText", CStr(value)
            Enable =1
         End If
         If ControlID$ = "but8" Then
            value = CStr(value) + "8"
            DlgText "FText", CStr(value)
            Enable =1
         End If
         If ControlID$ = "but9" Then
            value = CStr(value) + "9"
            DlgText "FText", CStr(value)
            Enable =1
         End If
         If ControlID$ = "butD" Then
            If InStr(1,value,".") = 0 Then
            value = CStr(value) + "."
            DlgText "FText", CStr(value)
            Enable =1
            End If
         End If
         If ControlID$ = "butB" Then
            value = Left(value,Len(value)-1)
            DlgText "FText", CStr(value)
            Enable =1
         End If

         If ControlID$ = "butX" Then
            value = CStr(value) + "X"
            DlgText "FText", CStr(value)
            Enable =1
         End If
         If ControlID$ = "butY" Then
            value = CStr(value) + "Y"
            DlgText "FText", CStr(value)
            Enable =1
         End If
         If ControlID$ = "butZ" Then
            value = CStr(value) + "Z"
            DlgText "FText", CStr(value)
            Enable =1
         End If
         If ControlID$ = "butA" Then
            value = CStr(value) + "A"
            DlgText "FText", CStr(value)
            Enable =1
         End If
         If ControlID$ = "butF" Then
            value = CStr(value) + "F"
            DlgText "FText", CStr(value)
            Enable =1
         End If
         If ControlID$ = "butS" Then
            value = CStr(value) + "S"
            DlgText "FText", CStr(value)
            Enable =1
         End If
         If ControlID$ = "butM" Then
            value = CStr(value) + "M"
            DlgText "FText", CStr(value)
            Enable =1
         End If
         If ControlID$ = "butSp" Then
            value = CStr(value) + " "
            DlgText "FText", CStr(value)
            Enable =1
         End If
         If ControlID$ = "butG" Then
            value = CStr(value) + "G"
            DlgText "FText", CStr(value)
            Enable =1
         End If


         If ControlID$ = "OK" Then
            Enable = -1
         End If
      Case 3 'Text verändert
         'MsgBox Dlg1.FText   
      Case Else
   End Select
   
   'Wert zurückgeben
   If Enable = -1 Then
      Enable = value
   End If

End Function

6

VB and the development of wizards / change virtual keyboard

« on: October 12, 2023, 03:54:41 AM »

Good morning
I use this macro to insert values into the dro
I have a problem, if I enter the value and press "OK" it's fine, if I press "CANCEL" it comes out and resets the dro, is it possible to modify it?
in the sense that by pressing "CANCEL" it comes out but DOES NOT change the value in the database. Since it is not within my capabilities/expertise, is there anyone who can help me?
Greetings


' TAST ASSE X
Global value As String

Sub Main
   'declare variables
   Dim Pos As Double
   Dim OldDroValue As Double
   Dim MinPos As Double
   Dim MaxPos As Double
   Dim DroNum  As Integer   
   'preset the variables
   MinPos = -1000.0
   MaxPos = 1000.0
   DroNum  = 800
   
   'get the actual DRO value
   OldDroValue = GetOemDro(DroNum)
   'show the virtual keyboard
   Call NumericKeyboard(DroNum,MinPos,MaxPos)   
   'get the new DRO value
   Pos = GetOEMDro(DroNum)   

End Sub

'TPS 01.12.2017
'numerische Eingabe
Function NumericKeyboard(ByVal DRONum As Integer , ByVal Min As Double , ByVal Max As Double) As Double
   Dim title As String
   value = "" 'GetOemDRO(DRONum)
   title = Header

   Speak ("  ASSE x") 'Avviso Vocale   
   Begin Dialog UserDialog1 410,10, 125, 240, "INSERIMENTO VALORI:"  , .Enable

   Picture 0, 0, 125, 210, "c:\mach3\bitmaps\Ita_Screenset\TASTIERA.bmp"
      PushButton 20, 10, 25, 25, "7", .but7
      PushButton 50, 10, 25, 25, "8", .but8
      PushButton 80, 10, 25, 25, "9", .but9

      PushButton 20, 40, 25, 25, "4", .but4
      PushButton 50, 40, 25, 25, "5", .but5
      PushButton 80, 40, 25, 25, "6", .but6
      
      PushButton 20, 70, 25, 25, "1", .but1
      PushButton 50, 70, 25, 25, "2", .but2
      PushButton 80, 70, 25, 25, "3", .but3

      PushButton 20, 100, 25, 25, ".", .butD
      PushButton 50, 100, 25, 25, "0", .but0
      PushButton 80, 100, 25, 25, "<-", .butB

      PushButton 20, 130, 25, 25, "+/-", .butN
      PushButton 50, 130, 25, 25, "00", .butA
      PushButton 80, 130, 25, 25, "Del", .butDel

      TextBox 20, 160, 85, 18, .FText
      PushButton 20, 185, 40, 18,"OK", .OK
      CancelButton 65, 185, 40, 18
      Text 50, 215, 100, 18," ASSE X"
   End Dialog

   Dim Dlg1 As UserDialog1

   Dlg1.FText = CStr(value)
   x = Dialog( Dlg1 )

   NumericKeyboard = CDbl(Dlg1.FText)
   If CDbl(Dlg1.FText) < Min Then NumericKeyboard = Min
   If CDbl(Dlg1.FText) > Max Then NumericKeyboard = Max
   
   SetOEMDro(DRONum,NumericKeyboard)   
End Function

Function Enable( ControlID$, Action%, SuppValue%)

   Select Case Action%
      Case 1
         
      Case 2 'Button wurde gerückt
         If ControlID$ = "but0" Then
            value = CStr(value) + "0"
            DlgText "FText", CStr(value)
            Enable =1
            Speak ("0") 'Avviso Vocale
         End If
         If ControlID$ = "but1" Then
            value = CStr(value) + "1"
            DlgText "FText", CStr(value)
            Enable =1
            Speak ("1") 'Avviso Vocale            
         End If
         If ControlID$ = "but2" Then
            value = CStr(value) + "2"
            DlgText "FText", CStr(value)
            Enable =1
            Speak ("2") 'Avviso Vocale
         End If
         If ControlID$ = "but3" Then
            value = CStr(value) + "3"
            DlgText "FText", CStr(value)
            Enable =1
            Speak ("3") 'Avviso Vocale
         End If
         If ControlID$ = "but4" Then
            value = CStr(value) + "4"
            DlgText "FText", CStr(value)
            Enable =1
            Speak ("4") 'Avviso Vocale
         End If
         If ControlID$ = "but5" Then
            value = CStr(value) + "5"
            DlgText "FText", CStr(value)
            Enable =1
            Speak ("5") 'Avviso Vocale
         End If
         If ControlID$ = "but6" Then
            value = CStr(value) + "6"
            DlgText "FText", CStr(value)
            Enable =1
            Speak ("6") 'Avviso Vocale
         End If
         If ControlID$ = "but7" Then
            value = CStr(value) + "7"
            DlgText "FText", CStr(value)
            Enable =1
            Speak ("7") 'Avviso Vocale
         End If
         If ControlID$ = "but8" Then
            value = CStr(value) + "8"
            DlgText "FText", CStr(value)
            Enable =1
            Speak ("8") 'Avviso Vocale
         End If
         If ControlID$ = "but9" Then
            value = CStr(value) + "9"
            DlgText "FText", CStr(value)
            Enable =1
            Speak ("9") 'Avviso Vocale
         End If
                  If ControlID$ = "butA" Then
            value = CStr(value) + "00"
            DlgText "FText", CStr(value)
            Enable =1
            Speak ("0 0") 'Avviso Vocale
         End If
         If ControlID$ = "butD" Then
            If InStr(1,value,".") = 0 Then
            value = CStr(value) + "."
            DlgText "FText", CStr(value)
            Enable =1
            Speak ("punto") 'Avviso Vocale
            End If
         End If
         If ControlID$ = "butB" Then
            value = Left(value,Len(value)-1)
            DlgText "FText", CStr(value)
            Enable =1
            Speak ("indietro") 'Avviso Vocale
         End If
         If ControlID$ = "butN" Then
            If Left(value,1) = "-" Then
               value = "+" + CStr(Right(value,Len(value)-1))
               Speak ("piu' ") 'Avviso Vocale
            Else
               If Left(value,1) = "+" Then
                  value = "-" + CStr(Right(value,Len(value)-1))
               Else
                  value = "-" + CStr(value)
                  Speak ("meno ") 'Avviso Vocale
               End If   
            End If   

            DlgText "FText", CStr(value)
            Enable =1

         End If
         If ControlID$ = "butDel" Then
            value = ""
            DlgText "FText", CStr(value)
            Enable =1
            Speak ("cancella ") 'Avviso Vocale
         End If
         If ControlID$ = "OK" Then
            Enable = -1
         End If
      Case 3 'Text verändert
         'MsgBox Dlg1.FText   
      Case Else
   End Select
   
   'Wert zurückgeben
   If Enable = -1 Then
      Enable = value
   End If

End Function     

     

7

VB and the development of wizards / Jog To Point Probing

« on: September 12, 2023, 05:53:36 AM »

Good morning
I use "Jog To Point Probing" for mach3 and I have to say it works well
for my work (hobby), I would like to change it when saving the file,
Is it possible to modify it to save in DXF?
I'll start by saying that it's not within my skill set and I don't know if it's one
which is doable.
I thank anyone who can help me
Greetings

8

VB and the development of wizards / edit macro digits

« on: April 08, 2023, 05:53:55 AM »

Good morning
I found this macro on the web, it works well, I kindly ask if anyone can modify it, since it is not in my skills and competences, the modification I would like to make is the following:
in the line " Open "C:\Mach3\SurfaceScan.txt" For Output As #iFileOutput " I would like if possible when saving if it finds a file with the same name that I store in "SurfaceScan1.txt .SurfaceScan2.txt , SurfaceScan3.txt, etc etc" I hope I made myself clear.
Thanks to anyone who can help me
Greetings

Code: [Select]

Option Explicit
 
Dim Xstart, Ystart, Zstart As Double
Dim Xdim, Ydim As Double
Dim Xpos, Ypos As Double
Dim Xcnt, Ycnt As Integer
Dim Xstep, Ystep As Double
Dim x, y As Integer
Dim FeedMeas, FeedMove As Double
Dim iFileOutput As Integer

FeedMeas=350
FeedMove=2500

Dim Title As String

Xdim=InputBox("Set scanning dimension in X",Title)
Ydim=InputBox("Set scanning dimension in Y",Title)

Xcnt=InputBox("Set number of samples in X",Title)
Ycnt=InputBox("Set number of samples in Y",Title)

If(Xcnt<1 Or Ycnt<0) Then
  MsgBox "Wrong parameters. Script terminated!",0,Title
  Exit Sub
End If

If(MsgBox("Start surface scanning?",4,Title)<>6) Then
  MsgBox "Script terminated!",0,Title
  Exit Sub
End If

ActivateSignal(OUTPUT4) 'aktivace digitizeru
Open "C:\Mach3\SurfaceScan.txt" For Output As #iFileOutput

If(Xcnt>1) Then
  XStep=Xdim/(Xcnt-1)
Else
  Xstep=0
End If

If(Ycnt>1) Then
  Ystep=Ydim/(Ycnt-1)
Else
  Ystep=0
End If

Xstart=GetOEMDRO(800)
Ystart=GetOEMDRO(801)
Zstart=GetOEMDRO(802)

For y=1 To Ycnt 
  Ypos=Ystart + (y-1) * Ystep 
  For x=1 To Xcnt
    Xpos=Xstart + (x-1) * Xstep
   
    Code "G90 G0 Z" & Zstart & " F" & FeedMove
    While IsMoving()
      Sleep(10)
    Wend

    Code "G90 G0 X" & Xpos & " Y" & Ypos & " F" & FeedMove
    While IsMoving()
      Sleep(10)
    Wend
   
    While GetOemLed (825) <> 0
      MsgBox "Sensor is active! Fix the sensor and continue.",0,Title
    Wend

   Code"G91 G31 Z-20 F" &FeedMeas
   Sleep(10)
   While IsMoving()
   Sleep(10)
   Wend
   
   Print #iFileOutput, "X" & roun(Xpos) & " Y" & roun(Ypos) & " Z" & roun(GetOEMDRO(802)) 
  Next x
Next y

Code "G90 G0 Z" & Zstart & " F" & FeedMove
While IsMoving()
  Sleep(10)
Wend

Code "G90 G0 X" & Xstart & " Y" & Ystart & " F" & FeedMove
While IsMoving()
  Sleep(10)
Wend

DeActivateSignal(OUTPUT4) 'aktivace digitizeru
Close #iFileOutput


9

VB and the development of wizards / edit macro file

« on: January 21, 2023, 06:29:06 AM »

hello, I have this macro (found on the net) to import files, since it is not within my capabilities and skills, I ask if anyone can correct it for me. what I would like to do is this: in addition to selecting the file, I would also like to choose the directory (the line is = PathName = "c:\mach3\quilting") I have 7 different working directories and I would like to choose the directory where to download the file. is it possible to change it? Is there anyone who can help me? I hope I explained myself and I thank anyone who can help me
I attach macros

Code: [Select]

'=========================================================
' Pattern File selection
'=========================================================
Option Explicit
Global fileName As String
Global fileExitCode As Integer
Global fileExtension As String

Declare Function GetDlgCtrlID Lib "User32" ( ByVal hwndCtl As Long ) As Long
Declare Function DlgDirListA Lib "User32" ( ByVal hDlg As Long, ByVal PathSpec As String, ByVal nIDListBox As Long, ByVal nIDStatic As Long, ByVal nFileType As Long ) As Long

Sub Main
  fileExtension = "*.tap" ' the extension we are looking for
  Call GetFileName ' as user for file name
  If Len(fileName) = 0 Then ' if 0 len cancel
      fileExitCode = 1
  End If
  If fileExitCode = 0 Then
      MsgBox("The Selected Pattern is: " & fileName)
      SavePatternName ' save the name for others
      SetUserLabel(8, fileName) ' Set the user label for all to see
  Else
      MsgBox("No Pattern Selected")
  End If
End Sub

Sub GetFileName
    Dim MyList$()
    Begin Dialog PatternDlg 60, 60, 180, 225, "Quilt Pattern Select", .DlgFunc
        TextBox 10, 15, 150, 12, .Text1
        Text 30, 45, 150, 9, "", .Path
        Text 15, 5, 150, 9, "Selection Criteria"
        Text 35, 35, 150, 9, "Selected Pattern"
        ListBox 25, 60, 125, 140, MyList(), .List1, 2 ' Sort
        CancelButton 42, 203, 40, 12   
        OKButton 90, 203, 40, 12
    End Dialog

    Dim frame As PatternDlg

    Dialog frame
   
End Sub

Function DlgFunc( controlID As String, action As Integer, suppValue As Integer )
    Static nPathID As Integer
    Static PathName As String
    Static nListID As Integer
    Static FileSpec As String


    Select Case action
    Case 1 ' Initialize
        PathName = "c:\mach3\quilting"
        DlgText "Text1", PathName & "\" & fileExtension
nListID = GetDlgCtrlID( DlgControlHWND("List1") )
nPathID = GetDlgCtrlID( DlgControlHWND("Path") )
        DlgDirListA DlgHWND, DlgText("Text1"), nListID, nPathID, &h10
    Case 2 ' Click
        If controlID = "Cancel" Then ' Cancel Button
            fileName=""
            fileExitCode=1
            DlgFunc = 0
            Exit Function
        End If
        If controlID = "OK" Then ' OK Button
            DlgDirListA DlgHWND, DlgText("Text1"), nListID, nPathID, &h10
            PathName = DlgText("Path")
            fileExitCode=0
            DlgFunc = 0
        Else
    FileSpec = DlgText("List1")
    If Left( FileSpec, 1 ) = "[" Then ' FileSpec is a directory
                PathName = Mid( FileSpec, 2, Len(FileSpec)-2 )
                DlgDirListA DlgHWND, PathName & "\" & fileExtension, nListID, nPathID, &h10
                PathName = DlgText("Path")
                If Right( PathName, 1 ) <> "\" Then
                    PathName = PathName & "\"
                End If
                DlgText "Text1", PathName & fileExtension
                Exit Function
            End If
            If Right( PathName, 1 ) <> "\" Then
               PathName = PathName & "\"
            End If
            fileName = PathName & DlgText("List1")
            DlgText "Path", fileName
        End If
    End Select
End Function 

Sub SavePatternName
'
' save the filename in Var(1-x) Len in 0
'
  Dim I
  Call SetVar(0,Len(fileName))
  For I = 1 To Len(fileName)
    Call SetVar(I,Asc(Mid(fileName,I,1)))
  Next I
End Sub

Sub GetPatternName
'
' get the filename in Var(1-x) Len in 0
'
  Dim lenStr, I, MyStr
  lenStr = GetVar(0)
  MyStr=""
  For I = 1 To lenStr
    MyStr=MyStr & Chr(GetVar(I))
  Next I
  fileName=MyStr
End Sub



Main


 




10

VB and the development of wizards / holes macro editing

« on: November 24, 2022, 04:45:23 AM »

good morning
I found on the net, some time ago, this macro to make holes, to work well, I tried to modify it in the part where the parameters are inserted, these are inserted one at a time in the original macro, if possible I would like a table at the beginning where I insert all the parameters like:
(similar type)

   Begin Dialog TextBoxSample 100,50,380,220,"PROVA"

      OKButton 80,195,40,15
      GroupBox 5,5,220,180,"  IMPOSTAZIONI  ",.GroupBox1
            Text 60,22,150,8,"VELOCITA' TASTATURA SONDA"'Pspeed
      TextBox 11,20,40,12,.TextBox1
        Text 60,42,150,8,"LUNGHEZZA PEZZO DAL CENTRO DIVISO 2"'Rleg
      TextBox 11,40,40,12,.TextBox2
        Text 60,62,150,8,"ANGOLO SPOSTAMENTO SONDAGGIO"'Linc
      TextBox 11,60,40,12,.TextBox3
        Text 60,82,150,8,"SPOSTAMENTO ALTEZZA SICURO ASSE  Z"'SafZ
      TextBox 11,80,40,12,.TextBox4
        Text 60,102,150,8,"ALTEZZA DISCESA INGRESSO SONDA"'Phgt
      TextBox 11,100,40,12,.TextBox5
          Text 60,122,150,8,"INGRESSO SONDA   0 ASSE X A ORE 6"'Spnt
      TextBox 11,120,40,12,.TextBox6
        Text 60,142,150,8,"LUNGHEZZA TASTATURA IN GRADI"'Tdeg 
      TextBox 11,140,40,12,.TextBox7
        Text 25,160,170,8,"@@ ATTENZIONE @@ POSIZIONARSI AL CENTRO DEL PEZZO"
        Text 25,170,170,8,"----------------------------------------------------------------------------------"
  End Dialog
 
   Dim Dlg1 As TextBoxSample
   Dialog Dlg1
   Pspeed = CDbl(Dlg1.TextBox1)
   Rleg = CDbl(Dlg1.TextBox2)
   Linc = CDbl(Dlg1.TextBox3)
   SafZ = CDbl(Dlg1.TextBox4)
   Phgt = CDbl(Dlg1.TextBox5)
   Spnt = CDbl(Dlg1.TextBox6)
   Tdeg = CDbl(Dlg1.TextBox7)
ecc ecc

the macro / script in question is this:

Code: [Select]

Dim Xpos, YPos, SpindleSpeed, Feed, Depth As Double
Dim Clearance, Peck, Dwell As Double
Dim i, Holes As Integer
  OpenTeachFile "G83 Drill.tap" 'Aprire il file di apprendimento, nome G83 Drill.tap
  SpindleSpeed = InputBox("Inserisci la velocità del mandrino desiderata:") 'Chiedi all'utente di inserire la velocità del mandrino
 Feed = InputBox("Inserisci l'avanzamento desiderato:") 'Chiedi all'utente di inserire l'avanzamento
  Code "M3 S" & SpindleSpeed & " F" & Feed 'Scrivi il codice G su file.
 Holes = InputBox("Quanti fori praticare?")'Chiedi all'utente quanti fori eseguire
  If Holes > 0 Then
  Depth = InputBox("Quanto sono profondi?")
  Peck = InputBox("Quanto profondo per beccato?")
  Clearance = InputBox("Inserisci l'altezza di gioco dell'asse Z tra i fori")
  Dwell = InputBox("Inserisci il tempo di permanenza in secondi")
 Xpos = InputBox("X Coordinata X per il foro n. " & 1 & "?")
 Ypos = InputBox("Y Coordinata Y per il foro n. " & 1 & "?")
    Code "G83 X" & XPos & " Y" & YPos & " Z-" & Depth & " R" & Clearance & " P" & Dwell & " Q" & Peck
    For i = 2 To Holes
    Xpos = InputBox("X Coordinata X per nr. " & i)
    Ypos = InputBox("Y Coordinata Y per il foro n. " & i)
    Code "X" & Xpos & " Y" & YPos
 Next
    Code "G80"
  End If
  LoadTeachFile()
  CloseTeachFile()
  DoOEMButton (1)
I tried to modify it but I couldn't figure it out, it's not in my skills, (I'm almost at zero in programming) is there anyone who can help me?