Richiesta script lotto, Sestine esagonali regolari.

« Older Newer »

Matrixpoker1

Posted on 26/10/2021, 17:15

Group:: Member

Posts:: 15

Status:

Buonasera, cortesemente avrei bisogno di uno script che mi trovi all' interno delle estrazioni del lotto 4 numeri ( 2 su una ruota e 2 su un altra ruota ) che appartengano ad una delle seguenti sestine regolari di distanza 15:

01-16-31-46-61-76
02-17-32-47-62-77
03-18-33-48-63-78
04-19-34-49-64-79
05-20-35-50-65-80
06-21-36-51-66-81
07-22-37-52-67-82
08-23-38-53-68-83
09-24-39-54-69-84
10-25-40-55-70-85
11-26-41-56-71-86
12-27-42-57-72-87
13-28-43-58-73-88
14-29-44-59-74-89
15-30-45-60-75-90

Per esempio:

BARI 03-78
TORINO 18-48

sono 4 numeri presenti all' interno della terza sestina e le ambate saranno i 2 numeri mancanti all' interno della sestina:

33 e 63

Qualcuno, per favore può farmi questo script ?

Grazie in anticipo.

ufolotto

Posted on 31/10/2021, 11:01

Group:: Member

Posts:: 799

Status:

Ciao , io ho questo script a distanza 15 , non li trova nella stessa figura ma può essere utile.

SPOILER (clicca per visualizzare)

Sub main()
Dim am1(10)
Dim ruote(10)
Dim poste(5)
poste(1)=1

rs=InputBox("Quante estrazioni vuoi controllare?",,50)

fin=EstrazioneFin
ini=fin-rs
For es=ini To fin
Messaggio DataEstrazione (es)

For r= 1 To 9
For i= 1 To 4
For j=i+1 To 5
a=Estratto (es,r,i)
b=Estratto(es,r,j)
c=Distanza (a,b)
For r2=r+1 To 10
aa=Estratto(es,r2,i)
bb=Estratto(es,r2,j)
cc=Distanza (aa,bb)
If c=cc And cc=15 Then
If Fuori90(a+15)<>b Then nw1=Fuori90(a+15) Else nw1=Fuori90(a+75)
If Fuori90(aa+15)<>bb Then nw2=Fuori90(aa+15)Else nw2=Fuori90(aa+75)

ColoreTesto 2 : Scrivi "=============================================================================",1
ColoreTesto 1 : Scrivi " < ambo isotopo - stessa Distanza 15 >" ,1
ColoreTesto 0
Scrivi "-----------------------------------------------------------------------------"
Scrivi DataEstrazione(es,1)
Scrivi SiglaRuota(r)&" "&StringaEstratti (es,r)
Scrivi SiglaRuota(r2)&" "&stringaestratti(es,r2)
Scrivi NomeRuota(r)&" "&Cint(a)&" e "&Cint(b)&" = Dist "&Cint(c)
Scrivi NomeRuota(r2)&" "&Cint(aa)&" e "&Cint(bb)&" = Dist "&Cint(cc)
Scrivi NomeRuota(r)&" Terzo elem.Simm. "& CInt (nw1) &" "& NomeRuota (r2)&" Terzo elem.Simm. "& CInt (nw2)

ColoreTesto 2 :Scrivi "-----------------------------------------------------------------------------"

ruote(1)=r
ruote(2)=r2

cou1=Fuori90 (a+aa+b+bb+1)
am1(1)=cou1
am1(2)=Diametrale (cou1)
ImpostaGiocata 1,am1,ruote,poste,12,1
Gioca es

End If
Next
Next
Next
Next
Next
ScriviResoconto
End Sub

Matrixpoker1

Posted on 31/10/2021, 11:57

Group:: Member

Posts:: 15

Status:

La ringrazio tantissimo per la sua disponibilità è stato molto gentile ma purtroppo non è quello che cercavo.
I 4 numeri di ricerca devono sempre essere all' interno di una delle delle 15 SESTINE ESAGONALI REGOLARI.
Comunque grazie.

ufolotto

Posted on 31/10/2021, 15:43

Group:: Member

Posts:: 799

Status:

Eccolo , mi ricordavo di averlo

SPOILER (clicca per visualizzare)

Sub main()
Dim ruote(2),ruot(1),nr(5),amb(1),ambo(3),terno(3),n(4)
Dim posta(1),poste(2)
Dim e1,e2,e3
posta(1)=1 ' Ambate
poste(2)=1 ' Ambo
'TabellaGiocate
'considero le ultime 100 estrazioni
rs=InputBox("Quante estrazioni vuoi controllare?",,50)
ini=EstrazioneFin -rs
fin=EstrazioneFin
t=0
For es=ini To fin
Messaggio "Estrazione esaminata: " & CStr(es)

' For rt= 1 To 10 'senza nazionale
For rt=1 To 11 'con nazionale
If rt=11 Then rt=12 'con nazionale
For p1= 1 To 4
For p2=p1+1 To 5
e1=Estratto(es,rt,p1) : e2=Estratto(es,rt,p2)
do1=Distanza (e1,e2)
If do1=15 Or do1=30 Then
For y=0 To 0 ' RETROATTIVITA' PER RICERCA NUMERI ESAGONALI
ex=es-y
For rr=1 To 11
If rr=11 Then rr=12 'con nazionale
For q1=1 To 4
For q2=q1+1 To 5
If rt<>rr Then 'cosi'le ruote saranno diverse-togliendola possone essere uguali
e3=Estratto(ex,rr,q1): e4=Estratto (ex,rr,q2)
If e3<>e1 And e3<>e2 And e4<>e1 And e4<>e2 Then
do2=Distanza (e3,e4)
If do2=15 Or do2=30 Then
dv1=Distanza (e1,e3):dv2=Distanza (e2,e4)
If dv1=15 Or dv1=30 And dv2=15 Or dv2=30 Then
nr(1)=Fuori90(e1):nr(2)=Fuori90(e1+15):nr(3)=Fuori90(e1+30):nr(4)=Fuori90(e1+60):nr(5)=Fuori90(e1+75)
OrdinaMatrice nr
n(1)=e1:n(2)=e2:n(3)=e3:n(4)=e4
OrdinaMatrice n
For i=1 To 5
k=0
For j=1 To 4
If nr(i)<>n(j) Then k=k+1
Next
If k=4 Then amb(1)=nr(i)
Next
t=t+1
ruote(1)=rt:ruote(2)=rr:ruot(1)=11
Scrivi
ColoreTesto 2 :Scrivi "------------------------------------------------------------"& "Giocata n° "& Format2(t),2
ColoreTesto 0
Scrivi DataEstrazione(es) &" "& SiglaRuota (rt) & " " & Format2 (e1) &" "& Format2 (e2)&""
Scrivi DataEstrazione(ex) &" "& SiglaRuota (rr) &" "& Format2 (e3) &" "& Format2 (e4)&""
Scrivi "** sestine esagonali : " & StringaNumeri (nr)&" [Num. mancante = "& Format2 (amb(1)) &"]",1
'Scrivi "--------------------------------------------------------------------------------------------------"
ImpostaGiocata 1,amb,ruote,posta,12,1
ambo(1)=amb(1)
ambo(2)=45
ImpostaGiocata 2,ambo,ruote,poste,12,2
ambo(1)=amb(1)
ambo(2)=54
ImpostaGiocata 3,ambo,ruote,poste,12,2
ambo(1)=amb(1)
ambo(2)=36
ImpostaGiocata 4,ambo,ruot,poste,12,2
ambo(1)=amb(1)
ambo(2)=27
ImpostaGiocata 5,ambo,ruot,poste,12,2
terno(1)=amb(1)
terno(2)=Fuori90(amb(1)+amb(1)+45)
terno(3)=Fuori90(amb(1)+amb(1))
ImpostaGiocata 6,terno,ruot,poste,12,2

Gioca es
End If
End If
End If
End If ' da togliere se si vuole anche su stessa ruota insieme a questa stringa sopra If rt<>rr Then
Next
Next
Next
Next
End If
Next
Next
Next
Next
ScriviResoconto
ColoreTesto 1 :Scrivi String(47,32)&"SESTINA ESAGONALE.",1
Scrivi
Scrivi String(58,32)&"Listato adattato da DjNomade",1
ColoreTesto 0
ColoreTesto 1
Scrivi String(70,"=")&"da un listato di franco florindi",1
ColoreTesto 0
End Sub

Matrixpoker1

Posted on 31/10/2021, 18:55

Group:: Member

Posts:: 15

Status:

E' proprio quello che cercavo l' unica differenza è che io considero come ambate tutti e 2 i numeri mancanti della sestina mentre il tuo listato come ambata prende in considerazione solo uno dei 2 numeri mancanti della sestina.
Comunque va bene così. Grazie sei stato gentilissimo.

Matrixpoker1

Posted on 1/11/2021, 00:26

Group:: Member

Posts:: 15

Status:

Ma questo DJ Nomade si può trovare su qualche sito oppure su qualche blog per potergli fare delle richieste di script ?
Grazie in anticipo per la risposta.

ufolotto

Posted on 1/11/2021, 10:34

Group:: Member

Posts:: 799

Status:

Altro numero mancante , in realtà non manca ! é in una delle 11 estrazioni precedenti delle 2 ruote .

Matrixpoker1

Posted on 1/11/2021, 10:37

Group:: Member

Posts:: 15

Status:

Allora non è proprio il programma che cercavo.Grazie ugualmente.

fermino1

Posted on 3/11/2021, 18:16

ciao Matrixpoker1 quarda se ti va bene questo
[SPSub Main()
Dim ruote(3),rtt(2)
Dim n(15),amb(10),nu(10),n1(6),n2(6),ro1(1),ro2(1),nr1(6),nr2(6),nn(6),p1(5),p2(5)
Dim posta(1),poste(2)
posta(1) = 1 : poste(2) = 1
ColoreTesto 2
Scrivi String(10,32) & " DUE AMBI DISTANZA 15 SU DUE RUOTE ",1
ColoreTesto 0
ini = 9868
fin = EstrazioneFin
For es = ini To fin
Messaggio(es)
'---------------------------
n(01) = "01.16.31.46.61.76"
n(02) = "02.17.32.47.62.77"
n(03) = "03.18.33.48.63.78"
n(04) = "04.19.34.49.64.79"
n(05) = "05.20.35.50.65.80"
n(06) = "06.21.36.51.66.81"
n(07) = "07.22.37.52.67.82"
n(08) = "08.23.38.53.68.83"
n(09) = "09.24.39.54.69.84"
n(10) = "10.25.40.55.70.85"
n(11) = "11.26.41.56.71.86"
n(12) = "12.27.42.57.72.87"
n(13) = "13.28.43.58.73.88"
n(14) = "14.29.44.59.74.89"
n(15) = "15.30.45.60.75.90"
For w = 1 To 15 '<---- quantità righe sestine
If n(w) = "" Then Exit Sub
n(w) = "0." & n(w)
s = Split(n(w),".")
For i = 1 To 06 '<---- quantità numeri
nu(i) = CInt(s(i))
Next
For r1 = 1 To 10
ro1(1) = r1
For j = 1 To 5
n1(j) = Estratto(es,r1,j)
Next
sf1 = SerieFreq(es,es,nu,ro1,2)
If sf1 = 1 Then
For r2 = r1 + 1 To 11
If r2 = 11 Then r2 = 12
ro2(1) = r2
For j = 1 To 5
n2(j) = Estratto(es,r2,j)
Next
sf2 = SerieFreq(es,es,nu,ro2,2)
If sf2 = 1 Then
g1 = 0 : g2 = 0 : Erase nr1 : Erase nr2 : Erase p1 : Erase p2
For y = 1 To 06 '<---- quantità numeri
For x = 1 To 05 '<---- quantità numeri delle estrazioni
If nu(y) = n1(

Then g1 = g1 + 1 : nr1(g1) = n1(

: p1(g1) = x
If nu(y) = n2(

Then g2 = g2 + 1 : nr2(g2) = n2(

: p2(g2) = x
Next : Next
If g1 = 2 And g2 = 2 And nr1(1) <> nr2(1) And nr1(1) <> nr2(2) And nr1(2) <> nr2(1) And nr1(2) <> nr2(2) Then
nn(1) = nr1(1):
nn(2) = nr1(2):
nn(3) = nr2(1):
nn(4) = nr2(2)
h = 0 : Erase amb
For z1 = 1 To 6 '<---- quantità numeri
g = 0
For z2 = 1 To 4 '<---- numeri da trovare
If nu(z1) <> nn(z2) Then g = g + 1
Next
If g = 4 Then h = h + 1 : amb(h) = nu(z1)
Next
ruote(1) = r1 : ruote(2) = r2:ruote(3) = 11
rtt(1) = r1
rtt(2) = r2
casi = casi + 1
Scrivi
Scrivi String(65,"*") & " caso n° " &(casi),1
Scrivi "" & DataEstrazione(es),1
Scrivi FormatSpace(NomeRuota(r1),10) & " " & StringaEstratti(es,r1) & " [" & Format2(nr1(1)) & " - " & Format2(nr1(2)) & "]" & _
" Pos. " & p1(1) & "° " & p1(2) & "°",1
Scrivi FormatSpace(NomeRuota(r2),10) & " " & StringaEstratti(es,r2) & " [" & Format2(nr2(1)) & " - " & Format2(nr2(2)) & "]" & _
" Pos. " & p2(1) & "° " & p2(2) & "°",1
Scrivi "Chiusura sestina " & StringaNumeri(amb),1
Scrivi "sestina di ric. n° [" & w & "] " & StringaNumeri(nu),1
Scrivi
ImpostaGiocata 1,amb,rtt,posta,12

ImpostaGiocata 2,amb,ruote,poste,12

Gioca es,1
End If
End If
Next
End If
Next
Next
Next
ScriviResoconto
End Sub
OILER][/SPOILER]

8 replies since 26/10/2021, 17:15 470 views