RISCHIETA SCRIPT X SPAZIOMETRIA

Dragon zf · Giovedì alle 01:30

Provando a prendere in considerazione anche il numero non isotopo e con tutte le figure.Grazie.

Reacher · Sabato alle 13:06

Sub Main()
Dim number(3), r1, r2, p1, p2, p3, p4, p5, n
Dim a, b, c, d, e
Dim ruote(12), poste(2)

poste(2) = 2 ' Posta per estratto/ambo (a seconda di come vuoi impostarla)

' Inizializzazione array ruote
For i = 1 To 12
ruote(i) = i
Next

' Ciclo estrazioni
For n = 10780 To EstrazioneFin
' Ciclo ruote r1
For r1 = 1 To 11
' Ciclo ruote r2
For r2 = r1 + 1 To 12 ' Ottimizzato: evita di controllare coppie doppie (es. 1-2 e 2-1)

' Ciclo posizioni per r1
For p1 = 1 To 4
For p2 = p1 + 1 To 5
a = Estratto(n, r1, p1)
b = Estratto(n, r1, p2)

' Ciclo posizioni per r2
For p3 = 1 To 3
For p4 = p3 + 1 To 4
For p5 = p4 + 1 To 5
c = Estratto(n, r2, p3)
d = Estratto(n, r2, p4)
e = Estratto(n, r2, p5)

' Verifica condizioni: tutti in figura 8 ed e uguale ad a oppure a b
If Figura(a) = 8 And Figura(b) = 8 And Figura(c) = 8 And Figura(d) = 8 And (e = a Or e = b) Then

' Calcolo dei numeri da giocare
number(1) = Vert(Diametrale(d))
number(2) = Diametrale(d)
number(3) = d ' Il diametrale del diametrale di d è d stesso

Scrivi "Rilevato su " & NomeRuota(r1) & " e " & NomeRuota(r2) & " il " & DataEstrazione

Scrivi "Ambata calcolata: " & Diametrale(number(1))

' Disegna la condizione rilevata (color blu)
ReDim MatrCasella(5, 1)
MatrCasella(1, 0) = r1 : MatrCasella(1, 1) = p1
MatrCasella(2, 0) = r1 : MatrCasella(2, 1) = p2
MatrCasella(3, 0) = r2 : MatrCasella(3, 1) = p3
MatrCasella(4, 0) = r2 : MatrCasella(4, 1) = p4
MatrCasella(5, 0) = r2 : MatrCasella(5, 1) = p5
Call DisegnaEstrazione(n, MatrCasella, , vbBlue)

' Ricerca dinamica del numero nell'estrazione successiva (n+1) sulla ruota r1
Dim posTrovata, i
posTrovata = 0
For i = 1 To 5
If Estratto(n + 1, r1, i) = number(1) Then
posTrovata = i
End If
Next

' Evidenziazione dell'esito immediato
If posTrovata > 0 Then
Scrivi "Numero " & number(1) & " trovato su " & NomeRuota(r1) & " in posizione " & posTrovata
ReDim MatrCasella2(1, 1)
MatrCasella2(1, 0) = r1
MatrCasella2(1, 1) = posTrovata
Call DisegnaEstrazione(n + 1, MatrCasella2, , vbRed)
Else
Scrivi "Il numero " & Diametrale(number(1)) & " non è uscito su " & NomeRuota(r1) & " al colpo successivo."
End If

Scrivi String(40, "-")

' Imposta e lancia la giocata sul tabellone di Spaziometria
ImpostaGiocata 1, number, ruote, poste, 10, 2
Gioca n, 1 ' Mostra il registro giocate nel report complessivo

End If
Next ' p5
Next ' p4
Next ' p3

Next ' p2
Next ' p1

Next ' r2
Next ' r1
Next ' n

End Sub

Dragon zf · Domenica alle 00:18

Reacher ha scritto:
Sub Main()
Dim number(3), r1, r2, p1, p2, p3, p4, p5, n
Dim a, b, c, d, e
Dim ruote(12), poste(2)

poste(2) = 2 ' Posta per estratto/ambo (a seconda di come vuoi impostarla)

' Inizializzazione array ruote
For i = 1 To 12
ruote(i) = i
Next

' Ciclo estrazioni
For n = 10780 To EstrazioneFin
' Ciclo ruote r1
For r1 = 1 To 11
' Ciclo ruote r2
For r2 = r1 + 1 To 12 ' Ottimizzato: evita di controllare coppie doppie (es. 1-2 e 2-1)

' Ciclo posizioni per r1
For p1 = 1 To 4
For p2 = p1 + 1 To 5
a = Estratto(n, r1, p1)
b = Estratto(n, r1, p2)

' Ciclo posizioni per r2
For p3 = 1 To 3
For p4 = p3 + 1 To 4
For p5 = p4 + 1 To 5
c = Estratto(n, r2, p3)
d = Estratto(n, r2, p4)
e = Estratto(n, r2, p5)

' Verifica condizioni: tutti in figura 8 ed e uguale ad a oppure a b
If Figura(a) = 8 And Figura(b) = 8 And Figura(c) = 8 And Figura(d) = 8 And (e = a Or e = b) Then

' Calcolo dei numeri da giocare
number(1) = Vert(Diametrale(d))
number(2) = Diametrale(d)
number(3) = d ' Il diametrale del diametrale di d è d stesso

Scrivi "Rilevato su " & NomeRuota(r1) & " e " & NomeRuota(r2) & " il " & DataEstrazione
Scrivi "Ambata calcolata: " & Diametrale(number(1))

' Disegna la condizione rilevata (color blu)
ReDim MatrCasella(5, 1)
MatrCasella(1, 0) = r1 : MatrCasella(1, 1) = p1
MatrCasella(2, 0) = r1 : MatrCasella(2, 1) = p2
MatrCasella(3, 0) = r2 : MatrCasella(3, 1) = p3
MatrCasella(4, 0) = r2 : MatrCasella(4, 1) = p4
MatrCasella(5, 0) = r2 : MatrCasella(5, 1) = p5
Call DisegnaEstrazione(n, MatrCasella, , vbBlue)

' Ricerca dinamica del numero nell'estrazione successiva (n+1) sulla ruota r1
Dim posTrovata, i
posTrovata = 0
For i = 1 To 5
If Estratto(n + 1, r1, i) = number(1) Then
posTrovata = i
End If
Next

' Evidenziazione dell'esito immediato
If posTrovata > 0 Then
Scrivi "Numero " & number(1) & " trovato su " & NomeRuota(r1) & " in posizione " & posTrovata
ReDim MatrCasella2(1, 1)
MatrCasella2(1, 0) = r1
MatrCasella2(1, 1) = posTrovata
Call DisegnaEstrazione(n + 1, MatrCasella2, , vbRed)
Else
Scrivi "Il numero " & Diametrale(number(1)) & " non è uscito su " & NomeRuota(r1) & " al colpo successivo."
End If

Scrivi String(40, "-")

' Imposta e lancia la giocata sul tabellone di Spaziometria
ImpostaGiocata 1, number, ruote, poste, 10, 2
Gioca n, 1 ' Mostra il registro giocate nel report complessivo

End If
Next ' p5
Next ' p4
Next ' p3

Next ' p2
Next ' p1

Next ' r2
Next ' r1
Next ' n

End Sub

Escono solo 2 previsioni che includono solo lo stesso numero isotopo ,dovresti provare a includere lo stesso numero non isotopo.Grazie.

Reacher · Domenica alle 07:14

Sub Main()
Dim number(3),r1,r2,p1,p2,p3,p4,p5,n
Dim a,b,c,d,e
Dim ruote(12),poste(2)

poste(2) = 2 ' Posta per estratto/ambo (a seconda di come vuoi impostarla)

' Inizializzazione array ruote
For i = 1 To 12
ruote(i) = i
Next

' Ciclo estrazioni
For n = 10780 To EstrazioneFin
' Ciclo ruote r1
For r1 = 1 To 11
' Ciclo ruote r2
For r2 = r1 + 1 To 12 ' Ottimizzato: evita di controllare coppie doppie (es. 1-2 e 2-1)

' Ciclo posizioni per r1
For p1 = 1 To 4
For p2 = p1 + 1 To 5
a = Estratto(n,r1,p1)
b = Estratto(n,r1,p2)

' Ciclo posizioni per r2
For p3 = 1 To 3
For p4 = p3 + 1 To 4
For p5 = p4 + 1 To 5
c = Estratto(n,r2,p3)
d = Estratto(n,r2,p4)
e = Estratto(n,r2,p5)

' Verifica condizioni: tutti in figura 8 ed e uguale ad a oppure a b
If Figura(a) = 8 And Figura(b) = 8 And Figura(c) = 8 And Figura(d) = 8 And (e = a Or e = b Or a=c Or a=d Or b=c Or b=d) Then

' Calcolo dei numeri da giocare
number(1) = Vert(Diametrale(d))
number(2) = Diametrale(d)
number(3) = d ' Il diametrale del diametrale di d è d stesso

Scrivi "Rilevato su " & NomeRuota(r1) & " e " & NomeRuota(r2) & " il " & DataEstrazione

Scrivi "Ambata calcolata: " & Diametrale(number(1))

' Disegna la condizione rilevata (color blu)
ReDim MatrCasella(5,1)
MatrCasella(1,0) = r1 : MatrCasella(1,1) = p1
MatrCasella(2,0) = r1 : MatrCasella(2,1) = p2
MatrCasella(3,0) = r2 : MatrCasella(3,1) = p3
MatrCasella(4,0) = r2 : MatrCasella(4,1) = p4
MatrCasella(5,0) = r2 : MatrCasella(5,1) = p5
Call DisegnaEstrazione(n,MatrCasella,,vbBlue)

' Ricerca dinamica del numero nell'estrazione successiva (n+1) sulla ruota r1
Dim posTrovata,i
posTrovata = 0
For i = 1 To 5
If Estratto(n + 1,r1,i) = number(1) Then
posTrovata = i
End If
Next

' Evidenziazione dell'esito immediato
If posTrovata > 0 Then
Scrivi "Numero " & number(1) & " trovato su " & NomeRuota(r1) & " in posizione " & posTrovata
ReDim MatrCasella2(1,1)
MatrCasella2(1,0) = r1
MatrCasella2(1,1) = posTrovata
Call DisegnaEstrazione(n + 1,MatrCasella2,,vbRed)
Else
Scrivi "Il numero " & Diametrale(number(1)) & " non è uscito su " & NomeRuota(r1) & " al colpo successivo."
End If

Scrivi String(40,"-")

' Imposta e lancia la giocata sul tabellone di Spaziometria
ImpostaGiocata 1,number,ruote,poste,10,2
Gioca n,1 ' Mostra il registro giocate nel report complessivo

End If
Next ' p5
Next ' p4
Next ' p3

Next ' p2
Next ' p1

Next ' r2
Next ' r1
Next ' n

End Sub

Dragon zf · Ieri alle 00:29

Reacher ha scritto:
Sub Main()
Dim number(3),r1,r2,p1,p2,p3,p4,p5,n
Dim a,b,c,d,e
Dim ruote(12),poste(2)

poste(2) = 2 ' Posta per estratto/ambo (a seconda di come vuoi impostarla)

' Inizializzazione array ruote
For i = 1 To 12
ruote(i) = i
Next

' Ciclo estrazioni
For n = 10780 To EstrazioneFin
' Ciclo ruote r1
For r1 = 1 To 11
' Ciclo ruote r2
For r2 = r1 + 1 To 12 ' Ottimizzato: evita di controllare coppie doppie (es. 1-2 e 2-1)

' Ciclo posizioni per r1
For p1 = 1 To 4
For p2 = p1 + 1 To 5
a = Estratto(n,r1,p1)
b = Estratto(n,r1,p2)

' Ciclo posizioni per r2
For p3 = 1 To 3
For p4 = p3 + 1 To 4
For p5 = p4 + 1 To 5
c = Estratto(n,r2,p3)
d = Estratto(n,r2,p4)
e = Estratto(n,r2,p5)

' Verifica condizioni: tutti in figura 8 ed e uguale ad a oppure a b
If Figura(a) = 8 And Figura(b) = 8 And Figura(c) = 8 And Figura(d) = 8 And (e = a Or e = b Or a=c Or a=d Or b=c Or b=d) Then

' Calcolo dei numeri da giocare
number(1) = Vert(Diametrale(d))
number(2) = Diametrale(d)
number(3) = d ' Il diametrale del diametrale di d è d stesso

Scrivi "Rilevato su " & NomeRuota(r1) & " e " & NomeRuota(r2) & " il " & DataEstrazione
Scrivi "Ambata calcolata: " & Diametrale(number(1))

' Disegna la condizione rilevata (color blu)
ReDim MatrCasella(5,1)
MatrCasella(1,0) = r1 : MatrCasella(1,1) = p1
MatrCasella(2,0) = r1 : MatrCasella(2,1) = p2
MatrCasella(3,0) = r2 : MatrCasella(3,1) = p3
MatrCasella(4,0) = r2 : MatrCasella(4,1) = p4
MatrCasella(5,0) = r2 : MatrCasella(5,1) = p5
Call DisegnaEstrazione(n,MatrCasella,,vbBlue)

' Ricerca dinamica del numero nell'estrazione successiva (n+1) sulla ruota r1
Dim posTrovata,i
posTrovata = 0
For i = 1 To 5
If Estratto(n + 1,r1,i) = number(1) Then
posTrovata = i
End If
Next

' Evidenziazione dell'esito immediato
If posTrovata > 0 Then
Scrivi "Numero " & number(1) & " trovato su " & NomeRuota(r1) & " in posizione " & posTrovata
ReDim MatrCasella2(1,1)
MatrCasella2(1,0) = r1
MatrCasella2(1,1) = posTrovata
Call DisegnaEstrazione(n + 1,MatrCasella2,,vbRed)
Else
Scrivi "Il numero " & Diametrale(number(1)) & " non è uscito su " & NomeRuota(r1) & " al colpo successivo."
End If

Scrivi String(40,"-")

' Imposta e lancia la giocata sul tabellone di Spaziometria
ImpostaGiocata 1,number,ruote,poste,10,2
Gioca n,1 ' Mostra il registro giocate nel report complessivo

End If
Next ' p5
Next ' p4
Next ' p3

Next ' p2
Next ' p1

Next ' r2
Next ' r1
Next ' n

End Sub

Grazie,se hai tempo puoi dare uno sguardo a un altro metodo che ho postato.

Reacher · Ieri alle 06:22

Lo stesso script per tutte le figure?

Dragon zf · Ieri alle 14:02

Reacher ha scritto:
Lo stesso script per tutte le figure?

https://forum.lottoced.com/threads/listato-x-spaziometria.2228580/ il nuovo

Reacher · Ieri alle 15:13

Semplicemente dove leggi figura a=8 cambia 8 con 3

Dragon zf · Ieri alle 15:19

Reacher ha scritto:
Semplicemente dove leggi figura a=8 cambia 8 con 3

Ho postato un altro metodo

Dragon zf · Ieri alle 15:21

Dragon zf ha scritto:
Ho postato un altro metodo

E' questo il nuovo ,ovviamente non solo la figura 3 ma tutte le figure da cercare.

Reacher · Ieri alle 15:22

Bisogna fare uno script per ogni figura altrimenti il pc va in panne

Reacher · Ieri alle 20:15

Dragon zf ha scritto:
E' questo il nuovo ,ovviamente non solo la figura 3 ma tutte le figure da cercare.

Sub Main()
Dim number(3),r1,r2,p1,p2,p3,p4,p5,n,r3,m(5)
Dim a,b,c,d,e
Dim ruote(12),poste(2)
poste(2) = 2 ' Posta per estratto/ambo (a seconda di come vuoi impostarla)
For i = 1 To 12
ruote(i) = i
Next

' Ciclo estrazioni
For n = 10780 To EstrazioneFin
' Ciclo ruote r1
For r1 = 1 To 11
' Ciclo ruote r2
For r2 = r1 + 1 To 12 ' Ottimizzato: evita di controllare coppie doppie (es. 1-2 e 2-1)

For p1 = 1 To 4
For p2 = p1 + 1 To 5
a = Estratto(n,r1,p1)
b = Estratto(n,r2,p2)

For r3 = r2 + 1 To 12
For p3 = 1 To 3
For p4 = p3 + 1 To 4
For p5 = p4 + 1 To 5
c = Estratto(n,r3,p3)
d = Estratto(n,r3,p4)
e = Estratto(n,r3,p5)

' Verifica condizioni: tutti in figura 8 ed e uguale ad a oppure a b
If Figura(a) = 3 And Figura(b) = 3 And Figura(c) = 3 And Figura(d) = 3 And Figura(e) = 3 Then

' Calcolo dei numeri da giocare
number(1) = Vert(Diametrale(d))
number(2) = Fuori90(number(1) + 18)
number(3) = Differenza(number(1),18)

Scrivi "Rilevato su " & NomeRuota(r1) & " e " & NomeRuota(r2) & " il " & DataEstrazione

Scrivi "Ambata calcolata: " & Diametrale(number(1))

' Disegna la condizione rilevata (color blu)
ReDim MatrCasella(5,1)
MatrCasella(1,0) = r1 : MatrCasella(1,1) = p1
MatrCasella(2,0) = r2 : MatrCasella(2,1) = p2
MatrCasella(3,0) = r3 : MatrCasella(3,1) = p3
MatrCasella(4,0) = r3 : MatrCasella(4,1) = p4
MatrCasella(5,0) = r3 : MatrCasella(5,1) = p5
Call DisegnaEstrazione(n,MatrCasella,,vbBlue)

' Ricerca dinamica del numero nell'estrazione successiva (n+1) sulla ruota r1
Dim posTrovata,i
posTrovata = 0
For i = 1 To 5
If Estratto(n + 1,r1,i) = number(1) Then
posTrovata = i
End If
Next

' Evidenziazione dell'esito immediato
If posTrovata > 0 Then
Scrivi "Numero " & number(1) & " trovato su " & NomeRuota(r1) & " in posizione " & posTrovata
ReDim MatrCasella2(1,1)
MatrCasella2(1,0) = r1
MatrCasella2(1,1) = posTrovata
Call DisegnaEstrazione(n + 1,MatrCasella2,,vbRed)
Else
Scrivi "Il numero " & Diametrale(number(1)) & " non è uscito su " & NomeRuota(r1) & " al colpo successivo."
End If

Scrivi String(40,"-")
m(1) = a:m(3) = c:m(4) = d:m(5) = e
DisegnaCerchioCiclometrico m
' Imposta e lancia la giocata sul tabellone di Spaziometria
ImpostaGiocata 1,number,ruote,poste,10,2
Gioca n,1 ' Mostra il registro giocate nel report complessivo

End If
Next ' p5
Next ' p4
Next ' p3

Next ' p2
Next ' p1

Next ' r2
Next ' r1
Next

Next ' n

End Sub

se il cerchio rallenta lo script lo levo

Dragon zf · Oggi alle 00:22

Reacher ha scritto:
Sub Main()
Dim number(3),r1,r2,p1,p2,p3,p4,p5,n,r3,m(5)
Dim a,b,c,d,e
Dim ruote(12),poste(2)
poste(2) = 2 ' Posta per estratto/ambo (a seconda di come vuoi impostarla)
For i = 1 To 12
ruote(i) = i
Next

' Ciclo estrazioni
For n = 10780 To EstrazioneFin
' Ciclo ruote r1
For r1 = 1 To 11
' Ciclo ruote r2
For r2 = r1 + 1 To 12 ' Ottimizzato: evita di controllare coppie doppie (es. 1-2 e 2-1)

For p1 = 1 To 4
For p2 = p1 + 1 To 5
a = Estratto(n,r1,p1)
b = Estratto(n,r2,p2)

For r3 = r2 + 1 To 12
For p3 = 1 To 3
For p4 = p3 + 1 To 4
For p5 = p4 + 1 To 5
c = Estratto(n,r3,p3)
d = Estratto(n,r3,p4)
e = Estratto(n,r3,p5)

' Verifica condizioni: tutti in figura 8 ed e uguale ad a oppure a b
If Figura(a) = 3 And Figura(b) = 3 And Figura(c) = 3 And Figura(d) = 3 And Figura(e) = 3 Then

' Calcolo dei numeri da giocare
number(1) = Vert(Diametrale(d))
number(2) = Fuori90(number(1) + 18)
number(3) = Differenza(number(1),18)

Scrivi "Rilevato su " & NomeRuota(r1) & " e " & NomeRuota(r2) & " il " & DataEstrazione
Scrivi "Ambata calcolata: " & Diametrale(number(1))

' Disegna la condizione rilevata (color blu)
ReDim MatrCasella(5,1)
MatrCasella(1,0) = r1 : MatrCasella(1,1) = p1
MatrCasella(2,0) = r2 : MatrCasella(2,1) = p2
MatrCasella(3,0) = r3 : MatrCasella(3,1) = p3
MatrCasella(4,0) = r3 : MatrCasella(4,1) = p4
MatrCasella(5,0) = r3 : MatrCasella(5,1) = p5
Call DisegnaEstrazione(n,MatrCasella,,vbBlue)

' Ricerca dinamica del numero nell'estrazione successiva (n+1) sulla ruota r1
Dim posTrovata,i
posTrovata = 0
For i = 1 To 5
If Estratto(n + 1,r1,i) = number(1) Then
posTrovata = i
End If
Next

' Evidenziazione dell'esito immediato
If posTrovata > 0 Then
Scrivi "Numero " & number(1) & " trovato su " & NomeRuota(r1) & " in posizione " & posTrovata
ReDim MatrCasella2(1,1)
MatrCasella2(1,0) = r1
MatrCasella2(1,1) = posTrovata
Call DisegnaEstrazione(n + 1,MatrCasella2,,vbRed)
Else
Scrivi "Il numero " & Diametrale(number(1)) & " non è uscito su " & NomeRuota(r1) & " al colpo successivo."
End If

Scrivi String(40,"-")
m(1) = a:m(3) = c:m(4) = d:m(5) = e
DisegnaCerchioCiclometrico m
' Imposta e lancia la giocata sul tabellone di Spaziometria
ImpostaGiocata 1,number,ruote,poste,10,2
Gioca n,1 ' Mostra il registro giocate nel report complessivo

End If
Next ' p5
Next ' p4
Next ' p3

Next ' p2
Next ' p1

Next ' r2
Next ' r1
Next

Next ' n

End Sub

se il cerchio rallenta lo script lo levo

RALLENTA DI MOLTO SI IMPALLA

Dragon zf · Oggi alle 00:23

Dragon zf ha scritto:
RALLENTA DI MOLTO SI IMPALLA

LA RICERCA FALLA SOLO SULLE RUOTE CONSIDERATE

Dragon zf · Oggi alle 00:44

SE HAI TEMPO FAI PURE QUESTI E NE HO MOLTISSIMI ALTRI ....

Dragon zf · Oggi alle 00:47

PER IL PRIMO METODO FAI LA RICERCA SOLO SU RUOTE CONSIDERATE E NE' NAZIONALE E TUTTE PRENDENDO TUTTE LE FIGURE,MENTRE INVECE PER IL SECONDO LO STESSO PRENDENDO TUTTE LE FIGURE E UN'ESTRAZIONE DI RICERCA A RITROSO PER LA CONDIZIONE E ANCHE PRENDENDO IN CONSIDERAZIONE LA'MBO NON ISOTOPO IN FIGURA ,OVVIAMENTE SOLO RUOTE CONSIDERATE.

Reacher · Oggi alle 06:49

Alleggerito senza cerchio e quadro estrazionale

Sub Main()
Dim number(3),r1,r2,p1,p2,p3,p4,p5,n,r3,m(5)
Dim a,b,c,d,e
Dim ruote(3),poste(2)
poste(1)=1
poste(2) = 2 ' Posta per estratto/ambo (a seconda di come vuoi impostarla)

For i = 1 To 3
ruote(i) = i
Next

' Ciclo estrazioni
For n = 10787 To EstrazioneFin
' Ciclo ruote r1
For r1 = 1 To 11
' Ciclo ruote r2
For r2 = r1 + 1 To 12 ' Ottimizzato: evita di controllare coppie doppie (es. 1-2 e 2-1)

For p1 = 1 To 4
For p2 = p1 + 1 To 5
a = Estratto(n,r1,p1)
b = Estratto(n,r2,p2)

For r3 = r2 + 1 To 12
For p3 = 1 To 3
For p4 = p3 + 1 To 4
For p5 = p4 + 1 To 5
c = Estratto(n,r3,p3)
d = Estratto(n,r3,p4)
e = Estratto(n,r3,p5)

' Verifica condizioni: tutti in figura 8 ed e uguale ad a oppure a b
If Figura(a) = 3 And Figura(b) = 3 And Figura(c) = 3 And Figura(d) = 3 And Figura(e) = 3 Then

' Calcolo dei numeri da giocare
number(1) = Vert(Diametrale(d))
number(2) = Fuori90(number(1) + 18)
number(3) = Differenza(number(1),18)

' Ricerca dinamica del numero nell'estrazione successiva (n+1) sulla ruota r1
Dim posTrovata,i
posTrovata = 0
For i = 1 To 5
If Estratto(n + 1,r1,i) = number(1) Then
posTrovata = i
End If
Next

Scrivi String(40,"-")

' Imposta e lancia la giocata sul tabellone di Spaziometria
ImpostaGiocata 1,number,ruote,poste,10,1
Gioca n,1 ' Mostra il registro giocate nel report complessivo

End If
Next ' p5
Next ' p4
Next ' p3

Next ' p2
Next ' p1

Next ' r2
Next ' r1
Next

Next ' n

End Sub

Reacher · Oggi alle 10:06

Modifica con scelta figura

Sub Main()
Dim n,aOpt(9),sceltaFig,k

' Menu di selezione della Figura
For k = 1 To 9
aOpt(k) = "Figura " & k
Next
sceltaFig = ScegliOpzioneMenu(aOpt,8,"Seleziona la Figura da ricercare:")
If sceltaFig <= 0 Then Exit Sub

' Ciclo principale Estrazioni
For n = 10780 To EstrazioneFin

' In base alla scelta, chiama la procedura con le SUE ruote e i SUOI numeri
Select Case sceltaFig
Case 1 : Call ElaboraFigura1

Case 2 : Call ElaboraFigura2

Case 3 : Call ElaboraFigura3

Case 8 : Call ElaboraFigura8

' ecc...
End Select

Next ' n
End Sub

' ==========================================
' LOGICA SPECIFICA FIGURA 3 (3 Ruote)
' ==========================================
Sub ElaboraFigura3

Dim r1,r2,r3,p1,p2,p3,p4,p5
Dim a,b,c,d,e
Dim number(3),ruote(2),poste(2)
poste(2) = 1

For r1 = 1 To 11
If r1 = 11 Then r1 = 12
For r2 = r1 + 1 To 11
If r2 = 11 Then r2 = 12
For r3 = r2 + 1 To 11
If r3 = 11 Then r3 = 12

For p1 = 1 To 4
For p2 = p1 + 1 To 5
a = Estratto(n,r1,p1)
b = Estratto(n,r2,p2)

For p3 = 1 To 3
For p4 = p3 + 1 To 4
For p5 = p4 + 1 To 5
c = Estratto(n,r3,p3)
d = Estratto(n,r3,p4)
e = Estratto(n,r3,p5)

If Figura(a) = 3 And Figura(b) = 3 And _
Figura(c) = 3 And Figura(d) = 3 And Figura(e) = 3 Then

ruote(1) = r1
ruote(2) = r2

number(1) = Vert(Diametrale(d))
number(2) = Fuori90(number(1) + 18)
number(3) = Differenza(number(1),18)

Call Scrivi("Estrazione " & n & " [FIG 3] - Ruote: " & NomeRuota(r1) & "-" & NomeRuota(r2) & "-" & NomeRuota(r3))
Call ImpostaGiocata(1,number,ruote,poste,10,2)
Call Gioca(n,1)
End If
Next
Next
Next
Next
Next
Next
Next
Next
End Sub

' ==========================================
' LOGICA SPECIFICA FIGURA 8 (2 Ruote, diverse condizioni)
' ==========================================
Sub ElaboraFigura8

Dim r1,r2,p1,p2
Dim a,b,c,d,e
Dim number(3),ruote(2),poste(2)
poste(2) = 1

For r1 = 1 To 10
For r2 = r1 + 1 To 11
If r2 = 11 Then r2 = 12

For p1 = 1 To 4
For p2 = p1 + 1 To 5
a = Estratto(n,r1,p1)
b = Estratto(n,r1,p2)
c = Estratto(n,r2,p1)
d = Estratto(n,r2,p2)
e = Estratto(n,r2,5)

If Figura(a) = 8 And Figura(b) = 8 And Figura(c) = 8 And Figura(d) = 8 Then
If(e = a Or e = b Or a = c Or a = d Or b = c Or b = d) Then

ruote(1) = r1
ruote(2) = r2

number(1) = Vert(Diametrale(d))
number(2) = Diametrale(d)
number(3) = d

Call Scrivi("Estrazione " & n & " [FIG 8] - Ruote: " & NomeRuota(r1) & "-" & NomeRuota(r2))
Call ImpostaGiocata(1,number,ruote,poste,10,2)
Call Gioca(n,1)
End If
End If
Next
Next
Next
Next
End Sub

' ==========================================
' LOGICA SPECIFICA FIGURA 2 (2 Ruote, diverse condizioni)
' ==========================================
Sub ElaboraFigura2

Dim r1,r2,p1,p2,p3,p4
Dim a,b,c,d
Dim number(3),ruote(2),poste(2)
poste(2) = 1

For r1 = 1 To 11
If r1 = 11 Then r1 = 12
For r2 = r1 + 1 To 11
If r2 = 11 Then r2 = 12

For p1 = 1 To 4
For p2 = p1 + 1 To 5
a = Estratto(n,r1,p1)
b = Estratto(n,r1,p2)

For p3 = 1 To 3
For p4 = p3 + 1 To 4

c = Estratto(n,r2,p3)
d = Estratto(n,r2,p4)

If Figura(a) = 2 And Figura(b) = 2 And _
Figura(c) = 2 And Figura(d) = 2 Then

ruote(1) = r1
ruote(2) = r2

number(1) = Vert(Diametrale(d))
number(2) = Fuori90(number(1) + 27)
number(3) = Differenza(number(1),27)

Call Scrivi("Estrazione " & n & " [FIG 3] - Ruote: " & NomeRuota(r1) & "-" & NomeRuota(r2) & "-" & NomeRuota(r3))
Call ImpostaGiocata(1,number,ruote,poste,10,2)
Call Gioca(n,1)
End If

Next
Next
Next
Next
Next
Next
End Sub

Dragon zf · Oggi alle 14:17

Reacher ha scritto:
Modifica con scelta figura

Sub Main()
Dim n,aOpt(9),sceltaFig,k

' Menu di selezione della Figura
For k = 1 To 9
aOpt(k) = "Figura " & k
Next
sceltaFig = ScegliOpzioneMenu(aOpt,8,"Seleziona la Figura da ricercare:")
If sceltaFig <= 0 Then Exit Sub

' Ciclo principale Estrazioni
For n = 10780 To EstrazioneFin

' In base alla scelta, chiama la procedura con le SUE ruote e i SUOI numeri
Select Case sceltaFig
Case 1 : Call ElaboraFigura1
Case 2 : Call ElaboraFigura2
Case 3 : Call ElaboraFigura3
Case 8 : Call ElaboraFigura8
' ecc...
End Select

Next ' n
End Sub

' ==========================================
' LOGICA SPECIFICA FIGURA 3 (3 Ruote)
' ==========================================
Sub ElaboraFigura3
Dim r1,r2,r3,p1,p2,p3,p4,p5
Dim a,b,c,d,e
Dim number(3),ruote(2),poste(2)
poste(2) = 1

For r1 = 1 To 11
If r1 = 11 Then r1 = 12
For r2 = r1 + 1 To 11
If r2 = 11 Then r2 = 12
For r3 = r2 + 1 To 11
If r3 = 11 Then r3 = 12

For p1 = 1 To 4
For p2 = p1 + 1 To 5
a = Estratto(n,r1,p1)
b = Estratto(n,r2,p2)

For p3 = 1 To 3
For p4 = p3 + 1 To 4
For p5 = p4 + 1 To 5
c = Estratto(n,r3,p3)
d = Estratto(n,r3,p4)
e = Estratto(n,r3,p5)

If Figura(a) = 3 And Figura(b) = 3 And _
Figura(c) = 3 And Figura(d) = 3 And Figura(e) = 3 Then

ruote(1) = r1
ruote(2) = r2

number(1) = Vert(Diametrale(d))
number(2) = Fuori90(number(1) + 18)
number(3) = Differenza(number(1),18)

Call Scrivi("Estrazione " & n & " [FIG 3] - Ruote: " & NomeRuota(r1) & "-" & NomeRuota(r2) & "-" & NomeRuota(r3))
Call ImpostaGiocata(1,number,ruote,poste,10,2)
Call Gioca(n,1)
End If
Next
Next
Next
Next
Next
Next
Next
Next
End Sub

' ==========================================
' LOGICA SPECIFICA FIGURA 8 (2 Ruote, diverse condizioni)
' ==========================================
Sub ElaboraFigura8
Dim r1,r2,p1,p2
Dim a,b,c,d,e
Dim number(3),ruote(2),poste(2)
poste(2) = 1

For r1 = 1 To 10
For r2 = r1 + 1 To 11
If r2 = 11 Then r2 = 12

For p1 = 1 To 4
For p2 = p1 + 1 To 5
a = Estratto(n,r1,p1)
b = Estratto(n,r1,p2)
c = Estratto(n,r2,p1)
d = Estratto(n,r2,p2)
e = Estratto(n,r2,5)

If Figura(a) = 8 And Figura(b) = 8 And Figura(c) = 8 And Figura(d) = 8 Then
If(e = a Or e = b Or a = c Or a = d Or b = c Or b = d) Then

ruote(1) = r1
ruote(2) = r2

number(1) = Vert(Diametrale(d))
number(2) = Diametrale(d)
number(3) = d

Call Scrivi("Estrazione " & n & " [FIG 8] - Ruote: " & NomeRuota(r1) & "-" & NomeRuota(r2))
Call ImpostaGiocata(1,number,ruote,poste,10,2)
Call Gioca(n,1)
End If
End If
Next
Next
Next
Next
End Sub

' ==========================================
' LOGICA SPECIFICA FIGURA 2 (2 Ruote, diverse condizioni)
' ==========================================
Sub ElaboraFigura2
Dim r1,r2,p1,p2,p3,p4
Dim a,b,c,d
Dim number(3),ruote(2),poste(2)
poste(2) = 1

For r1 = 1 To 11
If r1 = 11 Then r1 = 12
For r2 = r1 + 1 To 11
If r2 = 11 Then r2 = 12

For p1 = 1 To 4
For p2 = p1 + 1 To 5
a = Estratto(n,r1,p1)
b = Estratto(n,r1,p2)

For p3 = 1 To 3
For p4 = p3 + 1 To 4

c = Estratto(n,r2,p3)
d = Estratto(n,r2,p4)

If Figura(a) = 2 And Figura(b) = 2 And _
Figura(c) = 2 And Figura(d) = 2 Then

ruote(1) = r1
ruote(2) = r2

number(1) = Vert(Diametrale(d))
number(2) = Fuori90(number(1) + 27)
number(3) = Differenza(number(1),27)

Call Scrivi("Estrazione " & n & " [FIG 3] - Ruote: " & NomeRuota(r1) & "-" & NomeRuota(r2) & "-" & NomeRuota(r3))
Call ImpostaGiocata(1,number,ruote,poste,10,2)
Call Gioca(n,1)
End If

Next
Next
Next
Next
Next
Next
End Sub

Questo e' la soluzione migliore pero' alla figura 1 mi da' questo errore .Come rimediare?

Dragon zf · Oggi alle 14:18

Dragon zf ha scritto:
Questo e' la soluzione migliore pero' alla figura 1 mi da' questo errore .Come rimediare?

E' ottima la soluzione serve crearli in questo modo per non avere problemi.

RISCHIETA SCRIPT X SPAZIOMETRIA

Member

Allegati

Super Member >PLATINUM<

Member

Super Member >PLATINUM<

Member

Super Member >PLATINUM<

Member

Super Member >PLATINUM<

Member

Member

Allegati

Super Member >PLATINUM<

Super Member >PLATINUM<

Member

Member

Member

Allegati

Member

Super Member >PLATINUM<

Super Member >PLATINUM<

Member

Allegati

Member