Novità

Script su Metodi Cabalistici, Ciclometrici & C.

salvo50 ha scritto:
Alien, Franco2761, Giovanni81, Matematico, Rudivall, Serpico90, Xeroxs
Grazie!

Ciao a Tutti.

Dei 2 metodi richiesti, per primo ho fatto il secondo, IL QUADRATO DIAMETRALE perchè lo vedo più semplice, finito e lanciato mi sono accorto che le 2 somme uguali non sempre erano in verticale, a volte erano in orizzontale, e quando erano in orizzontale, negli abbinamenti per ambo c'erano dei doppioni, quindi quando la somma uguale era in orizzontale ho eliminato l'ambo doppio, però non mi piaceva come soluzione, quindi l'ho modificato un po' e ne ho fatto un'altro che sfrutta tutti e due le somme, cioè quando le 2 somme uguali sono orizzontali gli abbinamenti sono ricavati dalle somme diagonali e verticali, invece quando le 2 somme uguali sono in verticale segue il metodo esposto, gli abbinamenti sono ricavati dalle somme orizzontali e diagonali

In data 28-11-20, ho aggiunto un terzo script "Ambi Isotopi e Ruote Consecutive"

script 1 con eliminazione eventuale ambo doppio

Codice: 
Option Explicit
Sub Main
   Dim FIn,Es,Ini,Clp1,Clp2,Clp3,R1,R2,Caso
   Dim P1,P2,P3,P4,P,PP,E1,E2,A,B,C,D,Casi
   Dim DAB,DCD,Somma1,Somma2,Somma3,Amb,G,X
   Dim DiSoOr1,DiSoOr2,DiSoDi1,DiSoDi2,Salvo50
   Dim SomOr1,SomOr2,SomVe1,SomVe2,SomDi1,SomDi2
   Dim Amba(1),Ambo(2),M(4),Penta(5),Num(4)
   Dim Ruote(2),Ruots(1),Posta(1),Poste(2),Post(5)
   FIn = EstrazioneFin
   Ini = InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,9840)'9675
   Clp1 = InputBox("Per quanti colpi vuoi giocare l'Ambata?",,8)
   Clp2 = InputBox("Per quanti colpi vuoi giocare gli Ambi?",,8)
   Clp3 = InputBox("Per quanti colpi vuoi giocare la Cinquina?",,8)
   Call ScegliRange(Ini,FIn,Ini,FIn)
   Scrivi Space(12) & "IL QUADRATO DIAMETRALE 1 di FRANCO MONGILLO - SCRIPT SALVO50",1,,4,,3,,1
   Posta(1) = 1
   Poste(2) = 1
   'Post(2) = 1
   Post(3) = 1
   For Es = Ini To FIn
      Messaggio Es
      AvanzamentoElab Ini,FIn,Es
      Caso = 0
      For R1 = 1 To 10
         For P1 = 1 To 4
            For P2 = P1 + 1 To 5
               A = Estratto(Es,R1,P1)
               B = Estratto(Es,R1,P2)
               For R2 = R1 + 1 To 12
                  If R2 = 11 Then R2 = 12
                  For P3 = 1 To 4
                     For P4 = P3 + 1 To 5
                        C = Estratto(Es,R2,P3)
                        D = Estratto(Es,R2,P4)
                        DAB = Distanza(A,B) : DCD = Distanza(C,D)
                        If DAB = DCD Then
                           M(1) = A : M(2) = B : M(3) = C : M(4) = D
                           Call OrdinaMatrice(M,1)
                           'M1--M2
                           '|    |
                           'M4--M3
                           SomOr1 = Fuori90(M(1) + M(2)) : SomOr2 = Fuori90(M(3) + M(4))
                           SomDi1 = Fuori90(M(1) + M(3)) : SomDi2 = Fuori90(M(2) + M(4))
                           SomVe1 = Fuori90(M(1) + M(4)) : SomVe2 = Fuori90(M(2) + M(3))
                           Somma1 = Fuori90(SomOr1 + SomOr2)
                           Somma2 = Fuori90(SomDi1 + SomDi2)
                           Somma3 = Fuori90(SomVe1 + SomVe2)
                           Amb = ComplAdX(Somma1)
                           DiSoOr1 = Diametrale(SomOr1) : DiSoOr2 = Diametrale(SomOr2)
                           DiSoDi1 = Diametrale(SomDi1) : DiSoDi2 = Diametrale(SomDi2)
                           Num(1) = DiSoOr1 : Num(2) = DiSoOr2 : Num(3) = DiSoDi1 : Num(4) = DiSoOr2
                           Amba(1) = Amb
                           Penta(1) = Amb : Penta(2) = DiSoOr1 : Penta(3) = DiSoOr2 : Penta(4) = DiSoDi1 : Penta(5) = DiSoDi2
                           Caso = Caso + 1
                           Casi = Casi + 1
                           Scrivi String(89,"*") & " Casi Totali " & FormattaStringa(Casi,"0000"),1,,,1
                           Scrivi String(80,"*") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000"),1,,,2
                           Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
                           Scrivi "  " & SiglaRuota(R1) & " ",1,0
                           For P = 1 To 5
                              E1 = Estratto(Es,R1,P)
                              If E1 = A Or E1 = B Then
                                 ColoreTesto 2
                              Else
                                 ColoreTesto 0
                              End If
                              Scrivi Format2(E1) & " ",1,0
                              ColoreTesto 0
                           Next
                           Scrivi "  <-- Evidenziati con Distanza " & Format2(DAB),1,,,1
                           Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
                           Scrivi "  " & SiglaRuota(R2) & " ",1,0
                           For PP = 1 To 5
                              E2 = Estratto(Es,R2,PP)
                              If E2 = C Or E2 = D Then
                                 ColoreTesto 2
                              Else
                                 ColoreTesto 0
                              End If
                              Scrivi Format2(E2) & " ",1,0
                              ColoreTesto 0
                           Next
                           Scrivi "  <-- Evidenziati con Distanza " & Format2(DCD),1,,,1
                           Scrivi
                           Scrivi Space(4) & "Estr. Ordine" & Space(14) & "Somme " & Space(9),1,0
                           Scrivi "  Somme" & Space(9) & " Somme",1
                           Scrivi Space(4) & "Ciclometrico " & Space(10) & " Orizontali" & Space(7),1,0
                           Scrivi "Diagonali      Verticali",1
                           Scrivi Space(7) & Format2(M(1)) & " " & Format2(M(2)) & Space(20),1,0
                           Scrivi Format2(SomOr1) & Space(14) & Format2(SomDi1),1,0
                           Scrivi Space(14) & Format2(SomVe1),1
                           Scrivi Space(7) & Format2(M(4)) & " " & Format2(M(3)) & Space(20),1,0
                           Scrivi Format2(SomOr2) & Space(14) & Format2(SomDi2),1,0
                           Scrivi Space(14) & Format2(SomVe2),1
                           Scrivi Space(32) & String(34,"-"),1
                           Scrivi Space(6) & "Triplo Sommativo --> " & Space(5) & Format2(Somma1) & Space(14),1,0
                           Scrivi Format2(Somma2) & Space(14) & Format2(Somma3),1
                           Scrivi
                           Scrivi Space(10) & "Complemento a 90 del Triplo Sommativo " & Format2(Somma1),1,0
                           Scrivi " = " & Format2(Amb) & " Ambata",1
                           Scrivi
                           Scrivi Space(20) & " Abbinamenti per Ambo" & Space(20) & " Ambi Secchi",1,,,2
                           Scrivi Space(10) & " Il Diametrale di " & Format2(SomOr1) & " = " & "Abbinamento1 " & Format2(DiSoOr1),1,0
                           Scrivi Space(14) & "Ambo1 " & Format2(Amb) & " " & Format2(DiSoOr1),1
                           Scrivi Space(10) & " Il Diametrale di " & Format2(SomOr2) & " = " & "Abbinamento2 " & Format2(DiSoOr2),1,0
                           Scrivi Space(14) & "Ambo2 " & Format2(Amb) & " " & Format2(DiSoOr2),1
                           Scrivi Space(10) & " Il Diametrale di " & Format2(SomDi1) & " = " & "Abbinamento3 " & Format2(DiSoDi1),1,0
                           Scrivi Space(14) & "Ambo3 " & Format2(Amb) & " " & Format2(DiSoDi1),1
                           Scrivi Space(10) & " Il Diametrale di " & Format2(SomDi2) & " = " & "Abbinamento4 " & Format2(DiSoDi2),1,0
                           Scrivi Space(14) & "Ambo4 " & Format2(Amb) & " " & Format2(DiSoDi2),1
                           Scrivi
                           Scrivi Space(24) & " Cinquina " & StringaNumeri(Penta," ",True),1,,,1
                           Scrivi
                           Ruote(1) = R1
                           Ruote(2) = R2
                           Ruots(1) = TU_
                           EliminaRipetuti Num
                           G = 1
                           ImpostaGiocata G,Amba,Ruote,Posta,Clp1,1
                           For X = 1 To UBound(Num)
                              If Amba(1) <> Num(X)Then
                                 Ambo(1) = Amba(1): Ambo(2) = Num(X)
                                 If Ambo(2) > 0 Then
                                    G = G + 1
                                    ImpostaGiocata G,Ambo,Ruote,Poste,Clp2,2
                                 End If
                              End If
                           Next
                           G = G + 1
                           EliminaRipetuti Penta
                           ImpostaGiocata G,Penta,Ruots,Post,Clp3
                           Gioca Es,1,,1
                        End If
                     Next
                  Next
               Next
            Next
         Next
      Next
      If ScriptInterrotto Then Exit Sub
   Next
   ScriviResoconto
End Sub


script 2

Codice: 
Option Explicit
Sub Main
   Dim FIn,Es,Ini,Clp1,Clp2,Clp3,R1,R2,Caso
   Dim P1,P2,P3,P4,P,PP,E1,E2,A,B,C,D,Casi
   Dim DAB,DCD,Somma1,Somma2,Somma3,Amb,G,X
   Dim DiSoDi1,DiSoDi2,Salvo50
   Dim DiFOrVe1,DiFOrVe2,SomOrVe1,SomOrVe2
   Dim SomOr1,SomOr2,SomVe1,SomVe2,SomDi1,SomDi2
   Dim Amba(1),Ambo(2),M(4),Penta(5),Num(4)
   Dim Ruote(2),Ruots(1),Posta(1),Poste(2),Post(5)
   FIn = EstrazioneFin
   Ini = InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,9840)'9675
   Clp1 = InputBox("Per quanti colpi vuoi giocare l'Ambata?",,8)
   Clp2 = InputBox("Per quanti colpi vuoi giocare gli Ambi?",,8)
   Clp3 = InputBox("Per quanti colpi vuoi giocare la Cinquina?",,8)
   Call ScegliRange(Ini,FIn,Ini,FIn)
   Scrivi Space(12) & "IL QUADRATO DIAMETRALE 2 di FRANCO MONGILLO - SCRIPT SALVO50",1,,4,,3,,1
   Posta(1) = 1
   Poste(2) = 1
   'Post(2) = 1
   Post(3) = 1
   For Es = Ini To FIn
      Messaggio Es
      AvanzamentoElab Ini,FIn,Es
      Caso = 0
      For R1 = 1 To 10
         For P1 = 1 To 4
            For P2 = P1 + 1 To 5
               A = Estratto(Es,R1,P1)
               B = Estratto(Es,R1,P2)
               For R2 = R1 + 1 To 12
                  If R2 = 11 Then R2 = 12
                  For P3 = 1 To 4
                     For P4 = P3 + 1 To 5
                        C = Estratto(Es,R2,P3)
                        D = Estratto(Es,R2,P4)
                        DAB = Distanza(A,B) : DCD = Distanza(C,D)
                        If DAB = DCD Then
                           M(1) = A : M(2) = B : M(3) = C : M(4) = D
                           Call OrdinaMatrice(M,1)
                           'M1--M2
                           '|    |
                           'M4--M3
                           SomOr1 = Fuori90(M(1) + M(2)) : SomOr2 = Fuori90(M(3) + M(4))
                           SomDi1 = Fuori90(M(1) + M(3)) : SomDi2 = Fuori90(M(2) + M(4))
                           SomVe1 = Fuori90(M(1) + M(4)) : SomVe2 = Fuori90(M(2) + M(3))
                           Somma1 = Fuori90(SomOr1 + SomOr2)
                           Somma2 = Fuori90(SomDi1 + SomDi2)
                           Somma3 = Fuori90(SomVe1 + SomVe2)
                           Amb = ComplAdX(Somma1)
                           If SomOr1 <> SomOr2 Then
                              DiFOrVe1 = Diametrale(SomOr1) : DiFOrVe2 = Diametrale(SomOr2)
                              SomOrVe1 = SomOr1
                              SomOrVe2 = SomOr2
                           End If
                           If SomVe1 <> SomVe2 Then
                              DiFOrVe1 = Diametrale(SomVe1) : DiFOrVe2 = Diametrale(SomVe2)
                              SomOrVe1 = SomVe1
                              SomOrVe2 = SomVe2
                           End If
                           DiSoDi1 = Diametrale(SomDi1) : DiSoDi2 = Diametrale(SomDi2)
                           Num(1) = DiFOrVe1 : Num(2) = DiFOrVe2 : Num(3) = DiSoDi1 : Num(4) = DiFOrVe2
                           Amba(1) = Amb
                           Penta(1) = Amb : Penta(2) = DiFOrVe1 : Penta(3) = DiFOrVe2 : Penta(4) = DiSoDi1 : Penta(5) = DiSoDi2
                           Caso = Caso + 1
                           Casi = Casi + 1
                           Scrivi String(89,"*") & " Casi Totali " & FormattaStringa(Casi,"0000"),1,,,1
                           Scrivi String(80,"*") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000"),1,,,2
                           Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
                           Scrivi "  " & SiglaRuota(R1) & " ",1,0
                           For P = 1 To 5
                              E1 = Estratto(Es,R1,P)
                              If E1 = A Or E1 = B Then
                                 ColoreTesto 2
                              Else
                                 ColoreTesto 0
                              End If
                              Scrivi Format2(E1) & " ",1,0
                              ColoreTesto 0
                           Next
                           Scrivi "  <-- Evidenziati con Distanza " & Format2(DAB),1,,,1
                           Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
                           Scrivi "  " & SiglaRuota(R2) & " ",1,0
                           For PP = 1 To 5
                              E2 = Estratto(Es,R2,PP)
                              If E2 = C Or E2 = D Then
                                 ColoreTesto 2
                              Else
                                 ColoreTesto 0
                              End If
                              Scrivi Format2(E2) & " ",1,0
                              ColoreTesto 0
                           Next
                           Scrivi "  <-- Evidenziati con Distanza " & Format2(DCD),1,,,1
                           Scrivi
                           Scrivi Space(4) & "Estr. Ordine" & Space(14) & "Somme " & Space(9),1,0
                           Scrivi "  Somme" & Space(9) & " Somme",1
                           Scrivi Space(4) & "Ciclometrico " & Space(10) & " Orizontali" & Space(7),1,0
                           Scrivi "Diagonali      Verticali",1
                           Scrivi Space(7) & Format2(M(1)) & " " & Format2(M(2)) & Space(20),1,0
                           Scrivi Format2(SomOr1) & Space(14) & Format2(SomDi1),1,0
                           Scrivi Space(14) & Format2(SomVe1),1
                           Scrivi Space(7) & Format2(M(4)) & " " & Format2(M(3)) & Space(20),1,0
                           Scrivi Format2(SomOr2) & Space(14) & Format2(SomDi2),1,0
                           Scrivi Space(14) & Format2(SomVe2),1
                           Scrivi Space(32) & String(34,"-"),1
                           Scrivi Space(6) & "Triplo Sommativo --> " & Space(5) & Format2(Somma1) & Space(14),1,0
                           Scrivi Format2(Somma2) & Space(14) & Format2(Somma3),1
                           Scrivi
                           Scrivi Space(10) & "Complemento a 90 del Triplo Sommativo " & Format2(Somma1),1,0
                           Scrivi " = " & Format2(Amb) & " Ambata",1
                           Scrivi
                           Scrivi Space(20) & " Abbinamenti per Ambo" & Space(20) & " Ambi Secchi",1,,,2
                           Scrivi Space(10) & " Il Diametrale di " & Format2(SomOrVe1) & " = " & "Abbinamento1 " & Format2(DiFOrVe1),1,0
                           Scrivi Space(14) & "Ambo1 " & Format2(Amb) & " " & Format2(DiFOrVe1),1
                           Scrivi Space(10) & " Il Diametrale di " & Format2(SomOrVe2) & " = " & "Abbinamento2 " & Format2(DiFOrVe2),1,0
                           Scrivi Space(14) & "Ambo2 " & Format2(Amb) & " " & Format2(DiFOrVe2),1
                           Scrivi Space(10) & " Il Diametrale di " & Format2(SomDi1) & " = " & "Abbinamento3 " & Format2(DiSoDi1),1,0
                           Scrivi Space(14) & "Ambo3 " & Format2(Amb) & " " & Format2(DiSoDi1),1
                           Scrivi Space(10) & " Il Diametrale di " & Format2(SomDi2) & " = " & "Abbinamento4 " & Format2(DiSoDi2),1,0
                           Scrivi Space(14) & "Ambo4 " & Format2(Amb) & " " & Format2(DiSoDi2),1
                           Scrivi
                           Scrivi Space(24) & " Cinquina " & StringaNumeri(Penta," ",True),1,,,1
                           Scrivi
                           Ruote(1) = R1
                           Ruote(2) = R2
                           Ruots(1) = TU_
                           EliminaRipetuti Num
                           G = 1
                           ImpostaGiocata G,Amba,Ruote,Posta,Clp1,1
                           For X = 1 To UBound(Num)
                              If Amba(1) <> Num(X)Then
                                 Ambo(1) = Amba(1): Ambo(2) = Num(X)
                                 If Ambo(2) > 0 Then
                                    G = G + 1
                                    ImpostaGiocata G,Ambo,Ruote,Poste,Clp2,2
                                 End If
                              End If
                           Next
                           G = G + 1
                           EliminaRipetuti Penta
                           ImpostaGiocata G,Penta,Ruots,Post,Clp3
                           Gioca Es,1,,1
                        End If
                     Next
                  Next
               Next
            Next
         Next
      Next
      If ScriptInterrotto Then Exit Sub
   Next
   ScriviResoconto
End Sub


Ambi Isotopi e Ruote Consecutive

Codice: 
Option Explicit
Sub Main
   Dim FIn,Es,Ini,Clp1,Clp2,Clp3,R1,R2,Caso
   Dim P1,P2,P3,P4,P,PP,E1,E2,A,B,C,D,Casi
   Dim DAB,DCD,Somma1,Somma2,Somma3,Amb,G,X
   Dim DiSoDi1,DiSoDi2,Salvo50
   Dim DiFOrVe1,DiFOrVe2,SomOrVe1,SomOrVe2
   Dim SomOr1,SomOr2,SomVe1,SomVe2,SomDi1,SomDi2
   Dim Amba(1),Ambo(2),M(4),Penta(5),Num(4)
   Dim Ruote(2),Ruots(1),Posta(1),Poste(2),Post(5)
   FIn = EstrazioneFin
   Ini = InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,9840)'9675
   Clp1 = InputBox("Per quanti colpi vuoi giocare l'Ambata?",,8)
   Clp2 = InputBox("Per quanti colpi vuoi giocare gli Ambi?",,8)
   Clp3 = InputBox("Per quanti colpi vuoi giocare la Cinquina?",,8)
   Call ScegliRange(Ini,FIn,Ini,FIn)
   Scrivi Space(12) & "IL QUADRATO DIAMETRALE 3 di FRANCO MONGILLO - SCRIPT SALVO50",1,,4,,3,,1
   Posta(1) = 1
   Poste(2) = 1
   'Post(2) = 1
   Post(3) = 1
   For Es = Ini To FIn
      Messaggio Es
      AvanzamentoElab Ini,FIn,Es
      Caso = 0
      For R1 = 1 To 10
         For P1 = 1 To 4
            For P2 = P1 + 1 To 5
               A = Estratto(Es,R1,P1)
               B = Estratto(Es,R1,P2)
               R2 = R1 + 1
               If R2 = 11 Then R2 = 12
               C = Estratto(Es,R2,P1)
               D = Estratto(Es,R2,P2)
               DAB = Distanza(A,B) : DCD = Distanza(C,D)
               If DAB = DCD Then
                  M(1) = A : M(2) = B : M(3) = C : M(4) = D
                  Call OrdinaMatrice(M,1)
                  'M1--M2
                  '|    |
                  'M4--M3
                  SomOr1 = Fuori90(M(1) + M(2)) : SomOr2 = Fuori90(M(3) + M(4))
                  SomDi1 = Fuori90(M(1) + M(3)) : SomDi2 = Fuori90(M(2) + M(4))
                  SomVe1 = Fuori90(M(1) + M(4)) : SomVe2 = Fuori90(M(2) + M(3))
                  Somma1 = Fuori90(SomOr1 + SomOr2)
                  Somma2 = Fuori90(SomDi1 + SomDi2)
                  Somma3 = Fuori90(SomVe1 + SomVe2)
                  Amb = ComplAdX(Somma1)
                  If SomOr1 <> SomOr2 Then
                     DiFOrVe1 = Diametrale(SomOr1) : DiFOrVe2 = Diametrale(SomOr2)
                     SomOrVe1 = SomOr1
                     SomOrVe2 = SomOr2
                  End If
                  If SomVe1 <> SomVe2 Then
                     DiFOrVe1 = Diametrale(SomVe1) : DiFOrVe2 = Diametrale(SomVe2)
                     SomOrVe1 = SomVe1
                     SomOrVe2 = SomVe2
                  End If
                  DiSoDi1 = Diametrale(SomDi1) : DiSoDi2 = Diametrale(SomDi2)
                  Num(1) = DiFOrVe1 : Num(2) = DiFOrVe2 : Num(3) = DiSoDi1 : Num(4) = DiFOrVe2
                  Amba(1) = Amb
                  Penta(1) = Amb : Penta(2) = DiFOrVe1 : Penta(3) = DiFOrVe2 : Penta(4) = DiSoDi1 : Penta(5) = DiSoDi2
                  Caso = Caso + 1
                  Casi = Casi + 1
                  Scrivi String(89,"*") & " Casi Totali " & FormattaStringa(Casi,"0000"),1,,,1
                  Scrivi String(80,"*") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000"),1,,,2
                  Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
                  Scrivi "  " & SiglaRuota(R1) & " ",1,0
                  For P = 1 To 5
                     E1 = Estratto(Es,R1,P)
                     If E1 = A Or E1 = B Then
                        ColoreTesto 2
                     Else
                        ColoreTesto 0
                     End If
                     Scrivi Format2(E1) & " ",1,0
                     ColoreTesto 0
                  Next
                  Scrivi "  <-- Evidenziati con Distanza " & Format2(DAB),1,,,1
                  Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
                  Scrivi "  " & SiglaRuota(R2) & " ",1,0
                  For PP = 1 To 5
                     E2 = Estratto(Es,R2,PP)
                     If E2 = C Or E2 = D Then
                        ColoreTesto 2
                     Else
                        ColoreTesto 0
                     End If
                     Scrivi Format2(E2) & " ",1,0
                     ColoreTesto 0
                  Next
                  Scrivi "  <-- Evidenziati con Distanza " & Format2(DCD),1,,,1
                  Scrivi
                  Scrivi Space(4) & "Estr. Ordine" & Space(14) & "Somme " & Space(9),1,0
                  Scrivi "  Somme" & Space(9) & " Somme",1
                  Scrivi Space(4) & "Ciclometrico " & Space(10) & " Orizontali" & Space(7),1,0
                  Scrivi "Diagonali      Verticali",1
                  Scrivi Space(7) & Format2(M(1)) & " " & Format2(M(2)) & Space(20),1,0
                  Scrivi Format2(SomOr1) & Space(14) & Format2(SomDi1),1,0
                  Scrivi Space(14) & Format2(SomVe1),1
                  Scrivi Space(7) & Format2(M(4)) & " " & Format2(M(3)) & Space(20),1,0
                  Scrivi Format2(SomOr2) & Space(14) & Format2(SomDi2),1,0
                  Scrivi Space(14) & Format2(SomVe2),1
                  Scrivi Space(32) & String(34,"-"),1
                  Scrivi Space(6) & "Triplo Sommativo --> " & Space(5) & Format2(Somma1) & Space(14),1,0
                  Scrivi Format2(Somma2) & Space(14) & Format2(Somma3),1
                  Scrivi
                  Scrivi Space(10) & "Complemento a 90 del Triplo Sommativo " & Format2(Somma1),1,0
                  Scrivi " = " & Format2(Amb) & " Ambata",1
                  Scrivi
                  Scrivi Space(20) & " Abbinamenti per Ambo" & Space(20) & " Ambi Secchi",1,,,2
                  Scrivi Space(10) & " Il Diametrale di " & Format2(SomOrVe1) & " = " & "Abbinamento1 " & Format2(DiFOrVe1),1,0
                  Scrivi Space(14) & "Ambo1 " & Format2(Amb) & " " & Format2(DiFOrVe1),1
                  Scrivi Space(10) & " Il Diametrale di " & Format2(SomOrVe2) & " = " & "Abbinamento2 " & Format2(DiFOrVe2),1,0
                  Scrivi Space(14) & "Ambo2 " & Format2(Amb) & " " & Format2(DiFOrVe2),1
                  Scrivi Space(10) & " Il Diametrale di " & Format2(SomDi1) & " = " & "Abbinamento3 " & Format2(DiSoDi1),1,0
                  Scrivi Space(14) & "Ambo3 " & Format2(Amb) & " " & Format2(DiSoDi1),1
                  Scrivi Space(10) & " Il Diametrale di " & Format2(SomDi2) & " = " & "Abbinamento4 " & Format2(DiSoDi2),1,0
                  Scrivi Space(14) & "Ambo4 " & Format2(Amb) & " " & Format2(DiSoDi2),1
                  Scrivi
                  Scrivi Space(24) & " Cinquina " & StringaNumeri(Penta," ",True),1,,,1
                  Scrivi
                  Ruote(1) = R1
                  Ruote(2) = R2
                  Ruots(1) = TU_
                  EliminaRipetuti Num
                  G = 1
                  ImpostaGiocata G,Amba,Ruote,Posta,Clp1,1
                  For X = 1 To UBound(Num)
                     If Amba(1) <> Num(X)Then
                        Ambo(1) = Amba(1): Ambo(2) = Num(X)
                        If Ambo(2) > 0 Then
                           G = G + 1
                           ImpostaGiocata G,Ambo,Ruote,Poste,Clp2,2
                        End If
                     End If
                  Next
                  G = G + 1
                  EliminaRipetuti Penta
                  ImpostaGiocata G,Penta,Ruots,Post,Clp3
                  Gioca Es,1,,1
               End If
            Next
         Next
      Next
      If ScriptInterrotto Then Exit Sub
   Next
   ScriviResoconto
End Sub
Clicca per espandere...
Buona sera, come mai con L8+ non funziona?
Grazie. Cavaleri
 
cavaleri ha scritto:
Buona sera, come mai con L8+ non funziona?
Grazie. Cavaleri
Clicca per espandere...
Ecco lo script per Lottodesk

Ciao, Enplein.

Sub main()
Dim n1(4),n2(4),nc(4),amb(1),lg(4),ruote(2),ruota(1),posta(1),poste(3)
posta(1)=1:poste(2)=3:poste(3)=1.2
ce=InputBox("da quale estrazione vuoi controllare? ","estrazione",9000)
'k=InputBox ("per quanti colpi?","colpi di gioco",14)
qe = CInt(InputBox("Quante Estrazioni Indietro, Vuoi Andare per il Controllo?",,2))

ini=ce
fin=EstrazioneFin
Scrivi Space(8) & "AMBO QUADRUPLO E ISOTOPO - FRANCO MONGILLO - SCRIPT X LOTTODESK BY Enplein",1
Scrivi String(88,"="),1
Scrivi "Resoconto da "&DataEstrazione(ini,1)&" a "&_
DataEstrazione(fin,1)&" ("&(fin-ce)&" estr.)",1
For es=ini To EstrazioneFin
Messaggio "elab. estr. ["&(es)&_
"] di "&DataEstrazione (es,1)
For r1=1 To 10
For p1=1 To 4
For p2=p1+1 To 5
a1=Estratto (es,r1,p1):a2=Estratto (es,r1,p2) : sa=Fuori90 (a1+a2)
For r2=r1+1 To 11
If r2=11 Then r2=12
b1=Estratto (es,r2,p1):b2=Estratto (es,r2,p2) : sb=Fuori90 (b1+b2)
If sa=sb And a1<>b1 And a1<>b2 And a2<>b1 And a2<>b2 Then
n1(1)=a1 : n1(2)=a2 : n1(3)=b1 : n1(4)=b2
'Controllo retroattivo max 2,3,4...
For x=1 To qe
g=0 : ok=0 : Erase nc
c1=Estratto (es-x,r1,p1) : c2=Estratto (es-x,r1,p2) : sc=Fuori90 (c1+c2)
d1=Estratto (es-x,r2,p1) : d2=Estratto (es-x,r2,p2) : sd=Fuori90 (d1+d2)
If sc=sd And sc<>sa And c1<>d1 And c1<>d2 And c2<>d1 And c2<>d2 Then
n2(1)=c1 : n2(2)=c2 : n2(3)=d1 : n2(4)=d2

For i =1 To 4 : h=0: For j=1 To 4
If n1(i)=n2(j) Then h=h+1
Next
If h>0 Then g=g+1 : nc(g)=n1(i)
Next
End If
If g>0 Then ex=es-x : ok=1 : Exit For
Next
If ok=1 Then
amb(1)=Diametrale (nc(1))
lg(1)=amb(1):lg(2)=sa: lg(3)=sc:lg(4)=Fuori90 (sa+sc)
ruote(1)=r1:ruote(2)=r2:ruota(1)=11:cg=0

casi=casi+1:Scrivi String(90,"=")&" ",1
Scrivi DataEstrazione(es,1)&" [ "&siglaRuota(r1)&" - "&StringaEstratti(es,r1)&" ] ambo [ "&_
Format2(a1)&"."& Format2(a2)&" ] in "&(p1)&"^/"&(p2)&"^ Somma "& Format2 (sa)
Scrivi DataEstrazione(es,1)&" [ "&siglaRuota(r2)&" - "&StringaEstratti(es,r2)&" ] ambo [ "&_
Format2(b1)&"."& Format2(b2)&" ] in "&(p1)&"^/"&(p2)&"^"
Scrivi
Scrivi Space(15) & " Scelto di Andare a Ritroso di Massimo " & qe & " Estrazioni",1
Scrivi
Scrivi DataEstrazione(ex,1)&" [ "&siglaRuota(r1)&" - "&StringaEstratti(ex,r1)&" ] ambo [ "&_
Format2(c1)&"."& Format2(c2)&" ] in "&(p1)&"^/"&(p2)&"^ Somma "& Format2 (sc)
Scrivi DataEstrazione(ex,1)&" [ "&siglaRuota(r2)&" - "&StringaEstratti(ex,r2)&" ] ambo [ "&_
Format2(d1)&"."& Format2(d2)&" ] in "&(p1)&"^/"&(p2)&"^ "& Space (5)&" Num Rip."& StringaNumeri (nc)
Scrivi String(76,"-")&" caso n° "&(casi)
End If
End If
Next:Next:next:Next : Next
ScriviResoconto
Scrivi "Ambo Quadruplo Isotopo_Mongillo (script by &Enplein)"
End Sub
 
Enplein ha scritto:
Ecco lo script per Lottodesk

Ciao, Enplein.

Sub main()
Dim n1(4),n2(4),nc(4),amb(1),lg(4),ruote(2),ruota(1),posta(1),poste(3)
posta(1)=1:poste(2)=3:poste(3)=1.2
ce=InputBox("da quale estrazione vuoi controllare? ","estrazione",9000)
'k=InputBox ("per quanti colpi?","colpi di gioco",14)
qe = CInt(InputBox("Quante Estrazioni Indietro, Vuoi Andare per il Controllo?",,2))

ini=ce
fin=EstrazioneFin
Scrivi Space(8) & "AMBO QUADRUPLO E ISOTOPO - FRANCO MONGILLO - SCRIPT X LOTTODESK BY Enplein",1
Scrivi String(88,"="),1
Scrivi "Resoconto da "&DataEstrazione(ini,1)&" a "&_
DataEstrazione(fin,1)&" ("&(fin-ce)&" estr.)",1
For es=ini To EstrazioneFin
Messaggio "elab. estr. ["&(es)&_
"] di "&DataEstrazione (es,1)
For r1=1 To 10
For p1=1 To 4
For p2=p1+1 To 5
a1=Estratto (es,r1,p1):a2=Estratto (es,r1,p2) : sa=Fuori90 (a1+a2)
For r2=r1+1 To 11
If r2=11 Then r2=12
b1=Estratto (es,r2,p1):b2=Estratto (es,r2,p2) : sb=Fuori90 (b1+b2)
If sa=sb And a1<>b1 And a1<>b2 And a2<>b1 And a2<>b2 Then
n1(1)=a1 : n1(2)=a2 : n1(3)=b1 : n1(4)=b2
'Controllo retroattivo max 2,3,4...
For x=1 To qe
g=0 : ok=0 : Erase nc
c1=Estratto (es-x,r1,p1) : c2=Estratto (es-x,r1,p2) : sc=Fuori90 (c1+c2)
d1=Estratto (es-x,r2,p1) : d2=Estratto (es-x,r2,p2) : sd=Fuori90 (d1+d2)
If sc=sd And sc<>sa And c1<>d1 And c1<>d2 And c2<>d1 And c2<>d2 Then
n2(1)=c1 : n2(2)=c2 : n2(3)=d1 : n2(4)=d2

For i =1 To 4 : h=0: For j=1 To 4
If n1(i)=n2(j) Then h=h+1
Next
If h>0 Then g=g+1 : nc(g)=n1(i)
Next
End If
If g>0 Then ex=es-x : ok=1 : Exit For
Next
If ok=1 Then
amb(1)=Diametrale (nc(1))
lg(1)=amb(1):lg(2)=sa: lg(3)=sc:lg(4)=Fuori90 (sa+sc)
ruote(1)=r1:ruote(2)=r2:ruota(1)=11:cg=0

casi=casi+1:Scrivi String(90,"=")&" ",1
Scrivi DataEstrazione(es,1)&" [ "&siglaRuota(r1)&" - "&StringaEstratti(es,r1)&" ] ambo [ "&_
Format2(a1)&"."& Format2(a2)&" ] in "&(p1)&"^/"&(p2)&"^ Somma "& Format2 (sa)
Scrivi DataEstrazione(es,1)&" [ "&siglaRuota(r2)&" - "&StringaEstratti(es,r2)&" ] ambo [ "&_
Format2(b1)&"."& Format2(b2)&" ] in "&(p1)&"^/"&(p2)&"^"
Scrivi
Scrivi Space(15) & " Scelto di Andare a Ritroso di Massimo " & qe & " Estrazioni",1
Scrivi
Scrivi DataEstrazione(ex,1)&" [ "&siglaRuota(r1)&" - "&StringaEstratti(ex,r1)&" ] ambo [ "&_
Format2(c1)&"."& Format2(c2)&" ] in "&(p1)&"^/"&(p2)&"^ Somma "& Format2 (sc)
Scrivi DataEstrazione(ex,1)&" [ "&siglaRuota(r2)&" - "&StringaEstratti(ex,r2)&" ] ambo [ "&_
Format2(d1)&"."& Format2(d2)&" ] in "&(p1)&"^/"&(p2)&"^ "& Space (5)&" Num Rip."& StringaNumeri (nc)
Scrivi String(76,"-")&" caso n° "&(casi)
End If
End If
Next:Next:next:Next : Next
ScriviResoconto
Scrivi "Ambo Quadruplo Isotopo_Mongillo (script by &Enplein)"
End Sub
Clicca per espandere...
OK! grazie, molto gentile.
Saluti
 
Matematico ha scritto:
Ciao salvo50, ti allego un'altro ottimo metodo di alta ciclometria di Franco Mogillo .

Un saluto a tutti quelli che seguono questa sezione.
Clicca per espandere...
Ciao A tutti,,,,,
Chiedo cortesemente a Salvo se per caso ,sempre con i suoi tempi e la sua grande disponibilità se ha sviluppato uno script indicato da Matematico " Alta Ciclometria" di Franco Mogillo ....
Un grande ringraziamento tutti voi e in special modo Salvo per la sua maestria a creare questi ottimo script
Saluti
Serpico
 
Serpico 90 ha scritto:
Ciao A tutti,,,,,
Chiedo cortesemente a Salvo se per caso ,sempre con i suoi tempi e la sua grande disponibilità se ha sviluppato uno script indicato da Matematico " Alta Ciclometria" di Franco Mogillo ....
Un grande ringraziamento tutti voi e in special modo Salvo per la sua maestria a creare questi ottimo script
Saluti
Serpico
Clicca per espandere...
Ciao Serpico, lo stò facendo, ma non è semplice, la prima parte, quella delle basi dispari l'ho quasi finita, la seconda parte quella con le basi pari, che sembrava molto semplice, stò avendo delle difficoltà, comunque se non dovessi riuscirci, posterò solo la prima parte.
 
salvo50 ha scritto:
Ciao a Tutti.

Franco2761, Giovanni81, Matematico, Rudivall, Xeroxs
Grazie!



IL RETTANGOLO ASSOLUTO di ANTONIO FIACCO

Può capitare che si avverano delle distanze uguali superiori a 2, in questo caso lo script esegue solo l'ultima e se la prima era fattibile e l'ultima no (non era fattibile) , lo script scarta la combinazione, mi dispiace ma non sono riuscito a fare di meglio.


Codice: 
Option Explicit
Sub Main
   Dim FIn,Ini,Es,Clp,Salvo50,Caso,Casi
   Dim R1,R2,A,B,P1,P2,P5,P6,E1,E2,Sp
   Dim Dist2A,Dist3A,Dist4A,Dist5A
   Dim Dist2B,Dist3B,Dist4B,Dist5B
   Dim XA,XB,UgA,UgB,k1,K2,Nu1,Nu2,Nu3,Nu4
   Dim A1(5),B1(5),Qua(4),Ruo(2),Posta(4)
   Sp = " "
   FIn = EstrazioneFin
   Ini = InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,9830)
   Clp = InputBox("Per quanti colpi vuoi giocare la quartina?",,13)
   Call ScegliRange(Ini,FIn,Ini,FIn)
   Scrivi Space(8) & "IL RETTANGOLO ASSOLUTO di ANTONIO FIACCO - SCRIPT SALVO50",1,,4,,3,,1
   Posta(2) = 1
   Posta(3) = 1
   'Posta(4) = 1
   For Es = Ini To FIn
      Messaggio Es
      AvanzamentoElab Ini,FIn,Es
      Caso = 0
      For R1 = 1 To 10
         For P1 = 1 To 5
            A = Estratto(Es,R1,P1)
            If A > 0 Then
               For R2 = R1 + 1 To 12
                  If R2 = 11 Then R2 = 12
                  For P2 = 1 To 5
                     B = Estratto(Es,R2,P2)
                     If B > 0 Then
                        If B = Diametrale(A) Then
                           k1 = 0
                           For k1 = 1 To 5
                              A1(k1) = Estratto(Es,R1,k1)
                              If A1(k1) = A Then A1(k1) = 0
                           Next
                           Call OrdinaMatrice(A1,1)
                           Dist2A = Distanza(A,A1(2)) : Dist3A = Distanza(A,A1(3))
                           Dist4A = Distanza(A,A1(4)) : Dist5A = Distanza(A,A1(5))
                           '
                           K2 = 0
                           For K2 = 1 To 5
                              B1(K2) = Estratto(Es,R2,K2)
                              If B1(K2) = B Then B1(K2) = 0
                           Next
                           Call OrdinaMatrice(B1,1)
                           Dist2B = Distanza(B,B1(2)) : Dist3B = Distanza(B,B1(3))
                           Dist4B = Distanza(B,B1(4)) : Dist5B = Distanza(B,B1(5))
                           UgA = 0 : UgB = 0
                           If Dist2A = Dist2B Then XA = A1(2) : XB = B1(2) : UgA = Dist2A : UgB = Dist2B
                           If Dist2A = Dist3B Then XA = A1(2) : XB = B1(3) : UgA = Dist2A : UgB = Dist3B
                           If Dist2A = Dist4B Then XA = A1(2) : XB = B1(4) : UgA = Dist2A : UgB = Dist4B
                           If Dist2A = Dist5B Then XA = A1(2) : XB = B1(5) : UgA = Dist2A : UgB = Dist5B
                           '
                           If Dist3A = Dist2B Then XA = A1(3) : XB = B1(2) : UgA = Dist3A : UgB = Dist2B
                           If Dist3A = Dist3B Then XA = A1(3) : XB = B1(3) : UgA = Dist3A : UgB = Dist3B
                           If Dist3A = Dist4B Then XA = A1(3) : XB = B1(4) : UgA = Dist3A : UgB = Dist4B
                           If Dist3A = Dist5B Then XA = A1(3) : XB = B1(5) : UgA = Dist3A : UgB = Dist5B
                           '
                           If Dist4A = Dist2B Then XA = A1(4) : XB = B1(2) : UgA = Dist4A : UgB = Dist2B
                           If Dist4A = Dist3B Then XA = A1(4) : XB = B1(3) : UgA = Dist4A : UgB = Dist3B
                           If Dist4A = Dist4B Then XA = A1(4) : XB = B1(4) : UgA = Dist4A : UgB = Dist4B
                           If Dist4A = Dist5B Then XA = A1(4) : XB = B1(5) : UgA = Dist4A : UgB = Dist5B
                           '
                           If Dist5A = Dist2B Then XA = A1(5) : XB = B1(2) : UgA = Dist5A : UgB = Dist2B
                           If Dist5A = Dist3B Then XA = A1(5) : XB = B1(3) : UgA = Dist5A : UgB = Dist3B
                           If Dist5A = Dist4B Then XA = A1(5) : XB = B1(4) : UgA = Dist5A : UgB = Dist4B
                           If Dist5A = Dist5B Then XA = A1(5) : XB = B1(5) : UgA = Dist5A : UgB = Dist5B
                           If UgA = UgB And UgA > 0 Then
                              Nu1 = 0 : Nu2 = 0 : Nu3 = 0 : Nu4 = 0
                              If XB <> Diametrale(XA) Then
                                 If pari(A) And pari(B)Then Call Calcoli(A,B,XA,XB,Nu1,Nu2,Nu3,Nu4)
                                 If pari(A) And pari(XB)Then Call Calcoli(A,XB,XA,B,Nu1,Nu2,Nu3,Nu4)
                                 If pari(A) And pari(XA)Then Call Calcoli(A,XA,XB,B,Nu1,Nu2,Nu3,Nu4)
                                 If dispari(A) And dispari(XB) Then Call Calcoli(A,XB,XA,B,Nu1,Nu2,Nu3,Nu4)
                                 If dispari(A) And dispari(B)Then Call Calcoli(A,B,XA,XB,Nu1,Nu2,Nu3,Nu4)
                                 If dispari(A) And dispari(XA)Then Call Calcoli(A,XA,B,XB,Nu1,Nu2,Nu3,Nu4)
                                 Qua(1) = Nu1 : Qua(2) = Nu2 : Qua(3) = Nu3 : Qua(4) = Nu4
                                 Caso = Caso + 1
                                 Casi = Casi + 1
                                 ColoreTesto 1
                                 Scrivi String(89,"o") & " Casi Totali " & FormattaStringa(Casi,"0000")
                                 ColoreTesto 2
                                 Scrivi String(80,"o") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000")
                                 ColoreTesto 0
                                 Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
                                 Scrivi "  " & SiglaRuota(R1) & "  ",1,0
                                 For P5 = 1 To 5
                                    E1 = Estratto(Es,R1,P5)
                                    If E1 = A Then
                                       ColoreTesto 2
                                    Else
                                       ColoreTesto 0
                                    End If
                                    Scrivi Format2(E1) & " ",1,0
                                    ColoreTesto 0
                                 Next
                                 Scrivi
                                 Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
                                 Scrivi "  " & SiglaRuota(R2) & "  ",1,0
                                 For P6 = 1 To 5
                                    E2 = Estratto(Es,R2,P6)
                                    If E2 = B Then
                                       ColoreTesto 2
                                    Else
                                       ColoreTesto 0
                                    End If
                                    Scrivi Format2(E2) & " ",1,0
                                    ColoreTesto 0
                                 Next
                                 Scrivi
                                 Scrivi
                                 Scrivi Space(5) & Format2(A) & "-" & Format2(A1(2)) & " = Distanza " & Format2(Dist2A),1,0
                                 Scrivi Space(10) & Format2(B) & "-" & Format2(B1(2)) & " = Distanza " & Format2(Dist2B),1
                                 Scrivi Space(5) & Format2(A) & "-" & Format2(A1(3)) & " = Distanza " & Format2(Dist3A),1,0
                                 Scrivi Space(10) & Format2(B) & "-" & Format2(B1(3)) & " = Distanza " & Format2(Dist3B),1
                                 Scrivi Space(5) & Format2(A) & "-" & Format2(A1(4)) & " = Distanza " & Format2(Dist4A),1,0
                                 Scrivi Space(10) & Format2(B) & "-" & Format2(B1(4)) & " = Distanza " & Format2(Dist4B),1
                                 Scrivi Space(5) & Format2(A) & "-" & Format2(A1(5)) & " = Distanza " & Format2(Dist5A),1,0
                                 Scrivi Space(10) & Format2(B) & "-" & Format2(B1(5)) & " = Distanza " & Format2(Dist5B),1
                                 Scrivi
                                 Scrivi Space(17) & " La Distanza Uguale è " & Format2(UgA),1
                                 Scrivi Space(17) & "Pronostico   " & StringaNumeri(Qua," ",True),1
                              
                                 Ruo(1) = R1 : Ruo(2) = R2
                                 ImpostaGiocata 1,Qua,Ruo,Posta,Clp
                                 Gioca Es
                              End If
                           End If
                        End If
                     End If
                  Next
               Next
            End If
         Next
      Next
      If ScriptInterrotto Then Exit Sub
   Next
   ScriviResoconto
End Sub
Function Calcoli(N1,N2,N3,N4,Nu1,Nu2,Nu3,Nu4)
   Nu1 =((N1 + N2)\ 2)
   Nu2 = Diametrale(Nu1)
   Nu3 =((N3 + N4)\ 2)
   Nu4 = Diametrale(Nu3)
End Function
Clicca per espandere...
Buon giorno Salvo ,stamattina avevo inviato un messaggio ,ho vistora che non è stato registrato hanno fatto aggiornamenti .
lo rifaccio.
Chiedevo sempre se possibile e con i tuoi tempi in questo pregievole script fare una modifica cioè
all'inizio poter inserire due ruote e due numeri e poi fare la ricerca cosi come tu lo hai creato.
faccio un esempio
c.n.11 25.01.2020 ruote BARI 67
FIRENZE 22....


ALTRO ESEMPIO C.N.15 RUOTA FIRENZE 60
ROMA 15......
E COSI VIA PER ALTRE ESTRAZIONI
TUTTA LIMPOSTAZIONE DELLO SCRIPT RESTA COSI COME DA TE EGREGIAMENTE FATTO.

SE MI POTRESTI FARE QUESTA MODIFICA TE NE SAREI MOLTO MA VERAMENTE MOLTO GRATO
SPERO CHE QUESTO MESSAGGIO ARRIVI
SALUTO TUTTI UELLI CHE LEGGERANNO .
IN ATTESA DI UNA GRADITA RISPOSTA
sALUTI
sERPICP
 
Nel post 387 ho messo un nuovo script con la modifica richiesta.
Se nel l'output non c'è niente è perchè la combinazione di ruote e numeri non c'è
o le condizioni non sono tutte rispettate
 
Ultima modifica:
salvo50 ha scritto:
Ciao a Tutti.

Franco2761, Giovanni81, Matematico, Rudivall, Xeroxs
Grazie!



IL RETTANGOLO ASSOLUTO di ANTONIO FIACCO

Può capitare che si avverano delle distanze uguali superiori a 2, in questo caso lo script esegue solo l'ultima e se la prima era fattibile e l'ultima no (non era fattibile) , lo script scarta la combinazione, mi dispiace ma non sono riuscito a fare di meglio.


Codice: 
Option Explicit
Sub Main
   Dim FIn,Ini,Es,Clp,Salvo50,Caso,Casi
   Dim R1,R2,A,B,P1,P2,P5,P6,E1,E2,Sp
   Dim Dist2A,Dist3A,Dist4A,Dist5A
   Dim Dist2B,Dist3B,Dist4B,Dist5B
   Dim XA,XB,UgA,UgB,k1,K2,Nu1,Nu2,Nu3,Nu4
   Dim A1(5),B1(5),Qua(4),Ruo(2),Posta(4)
   Sp = " "
   FIn = EstrazioneFin
   Ini = InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,9830)
   Clp = InputBox("Per quanti colpi vuoi giocare la quartina?",,13)
   Call ScegliRange(Ini,FIn,Ini,FIn)
   Scrivi Space(8) & "IL RETTANGOLO ASSOLUTO di ANTONIO FIACCO - SCRIPT SALVO50",1,,4,,3,,1
   Posta(2) = 1
   Posta(3) = 1
   'Posta(4) = 1
   For Es = Ini To FIn
      Messaggio Es
      AvanzamentoElab Ini,FIn,Es
      Caso = 0
      For R1 = 1 To 10
         For P1 = 1 To 5
            A = Estratto(Es,R1,P1)
            If A > 0 Then
               For R2 = R1 + 1 To 12
                  If R2 = 11 Then R2 = 12
                  For P2 = 1 To 5
                     B = Estratto(Es,R2,P2)
                     If B > 0 Then
                        If B = Diametrale(A) Then
                           k1 = 0
                           For k1 = 1 To 5
                              A1(k1) = Estratto(Es,R1,k1)
                              If A1(k1) = A Then A1(k1) = 0
                           Next
                           Call OrdinaMatrice(A1,1)
                           Dist2A = Distanza(A,A1(2)) : Dist3A = Distanza(A,A1(3))
                           Dist4A = Distanza(A,A1(4)) : Dist5A = Distanza(A,A1(5))
                           '
                           K2 = 0
                           For K2 = 1 To 5
                              B1(K2) = Estratto(Es,R2,K2)
                              If B1(K2) = B Then B1(K2) = 0
                           Next
                           Call OrdinaMatrice(B1,1)
                           Dist2B = Distanza(B,B1(2)) : Dist3B = Distanza(B,B1(3))
                           Dist4B = Distanza(B,B1(4)) : Dist5B = Distanza(B,B1(5))
                           UgA = 0 : UgB = 0
                           If Dist2A = Dist2B Then XA = A1(2) : XB = B1(2) : UgA = Dist2A : UgB = Dist2B
                           If Dist2A = Dist3B Then XA = A1(2) : XB = B1(3) : UgA = Dist2A : UgB = Dist3B
                           If Dist2A = Dist4B Then XA = A1(2) : XB = B1(4) : UgA = Dist2A : UgB = Dist4B
                           If Dist2A = Dist5B Then XA = A1(2) : XB = B1(5) : UgA = Dist2A : UgB = Dist5B
                           '
                           If Dist3A = Dist2B Then XA = A1(3) : XB = B1(2) : UgA = Dist3A : UgB = Dist2B
                           If Dist3A = Dist3B Then XA = A1(3) : XB = B1(3) : UgA = Dist3A : UgB = Dist3B
                           If Dist3A = Dist4B Then XA = A1(3) : XB = B1(4) : UgA = Dist3A : UgB = Dist4B
                           If Dist3A = Dist5B Then XA = A1(3) : XB = B1(5) : UgA = Dist3A : UgB = Dist5B
                           '
                           If Dist4A = Dist2B Then XA = A1(4) : XB = B1(2) : UgA = Dist4A : UgB = Dist2B
                           If Dist4A = Dist3B Then XA = A1(4) : XB = B1(3) : UgA = Dist4A : UgB = Dist3B
                           If Dist4A = Dist4B Then XA = A1(4) : XB = B1(4) : UgA = Dist4A : UgB = Dist4B
                           If Dist4A = Dist5B Then XA = A1(4) : XB = B1(5) : UgA = Dist4A : UgB = Dist5B
                           '
                           If Dist5A = Dist2B Then XA = A1(5) : XB = B1(2) : UgA = Dist5A : UgB = Dist2B
                           If Dist5A = Dist3B Then XA = A1(5) : XB = B1(3) : UgA = Dist5A : UgB = Dist3B
                           If Dist5A = Dist4B Then XA = A1(5) : XB = B1(4) : UgA = Dist5A : UgB = Dist4B
                           If Dist5A = Dist5B Then XA = A1(5) : XB = B1(5) : UgA = Dist5A : UgB = Dist5B
                           If UgA = UgB And UgA > 0 Then
                              Nu1 = 0 : Nu2 = 0 : Nu3 = 0 : Nu4 = 0
                              If XB <> Diametrale(XA) Then
                                 If pari(A) And pari(B)Then Call Calcoli(A,B,XA,XB,Nu1,Nu2,Nu3,Nu4)
                                 If pari(A) And pari(XB)Then Call Calcoli(A,XB,XA,B,Nu1,Nu2,Nu3,Nu4)
                                 If pari(A) And pari(XA)Then Call Calcoli(A,XA,XB,B,Nu1,Nu2,Nu3,Nu4)
                                 If dispari(A) And dispari(XB) Then Call Calcoli(A,XB,XA,B,Nu1,Nu2,Nu3,Nu4)
                                 If dispari(A) And dispari(B)Then Call Calcoli(A,B,XA,XB,Nu1,Nu2,Nu3,Nu4)
                                 If dispari(A) And dispari(XA)Then Call Calcoli(A,XA,B,XB,Nu1,Nu2,Nu3,Nu4)
                                 Qua(1) = Nu1 : Qua(2) = Nu2 : Qua(3) = Nu3 : Qua(4) = Nu4
                                 Caso = Caso + 1
                                 Casi = Casi + 1
                                 ColoreTesto 1
                                 Scrivi String(89,"o") & " Casi Totali " & FormattaStringa(Casi,"0000")
                                 ColoreTesto 2
                                 Scrivi String(80,"o") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000")
                                 ColoreTesto 0
                                 Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
                                 Scrivi "  " & SiglaRuota(R1) & "  ",1,0
                                 For P5 = 1 To 5
                                    E1 = Estratto(Es,R1,P5)
                                    If E1 = A Then
                                       ColoreTesto 2
                                    Else
                                       ColoreTesto 0
                                    End If
                                    Scrivi Format2(E1) & " ",1,0
                                    ColoreTesto 0
                                 Next
                                 Scrivi
                                 Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
                                 Scrivi "  " & SiglaRuota(R2) & "  ",1,0
                                 For P6 = 1 To 5
                                    E2 = Estratto(Es,R2,P6)
                                    If E2 = B Then
                                       ColoreTesto 2
                                    Else
                                       ColoreTesto 0
                                    End If
                                    Scrivi Format2(E2) & " ",1,0
                                    ColoreTesto 0
                                 Next
                                 Scrivi
                                 Scrivi
                                 Scrivi Space(5) & Format2(A) & "-" & Format2(A1(2)) & " = Distanza " & Format2(Dist2A),1,0
                                 Scrivi Space(10) & Format2(B) & "-" & Format2(B1(2)) & " = Distanza " & Format2(Dist2B),1
                                 Scrivi Space(5) & Format2(A) & "-" & Format2(A1(3)) & " = Distanza " & Format2(Dist3A),1,0
                                 Scrivi Space(10) & Format2(B) & "-" & Format2(B1(3)) & " = Distanza " & Format2(Dist3B),1
                                 Scrivi Space(5) & Format2(A) & "-" & Format2(A1(4)) & " = Distanza " & Format2(Dist4A),1,0
                                 Scrivi Space(10) & Format2(B) & "-" & Format2(B1(4)) & " = Distanza " & Format2(Dist4B),1
                                 Scrivi Space(5) & Format2(A) & "-" & Format2(A1(5)) & " = Distanza " & Format2(Dist5A),1,0
                                 Scrivi Space(10) & Format2(B) & "-" & Format2(B1(5)) & " = Distanza " & Format2(Dist5B),1
                                 Scrivi
                                 Scrivi Space(17) & " La Distanza Uguale è " & Format2(UgA),1
                                 Scrivi Space(17) & "Pronostico   " & StringaNumeri(Qua," ",True),1
                             
                                 Ruo(1) = R1 : Ruo(2) = R2
                                 ImpostaGiocata 1,Qua,Ruo,Posta,Clp
                                 Gioca Es
                              End If
                           End If
                        End If
                     End If
                  Next
               Next
            End If
         Next
      Next
      If ScriptInterrotto Then Exit Sub
   Next
   ScriviResoconto
End Sub
Function Calcoli(N1,N2,N3,N4,Nu1,Nu2,Nu3,Nu4)
   Nu1 =((N1 + N2)\ 2)
   Nu2 = Diametrale(Nu1)
   Nu3 =((N3 + N4)\ 2)
   Nu4 = Diametrale(Nu3)
End Function

Con scelta ruote e numeri (modifica chiesta da Serpico 90)

Codice: 
Option Explicit
Sub Main
   Dim FIn,Ini,Es,Clp,Salvo50,Caso,Casi
   Dim R1,R2,A,B,P1,P2,P5,P6,E1,E2,Sp
   Dim Dist2A,Dist3A,Dist4A,Dist5A,AA
   Dim Dist2B,Dist3B,Dist4B,Dist5B,BB
   Dim XA,XB,UgA,UgB,k1,K2,Nu1,Nu2,Nu3,Nu4
   Dim A1(5),A2(5),B1(5),B2(5),Qua(4),Ruo(2),Posta(4)
   Sp = " "
   FIn = EstrazioneFin
   Ini = InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,9830)
   R1 = InputBox("Inserisci Il Numero Della Prima Ruota",Salvo50,3)
   AA = CInt(InputBox("Inserisci Il Numero Dell'Estratto Della Prima Ruota",Salvo50,2))
   R2 = InputBox("Inserisci Il Numero Della seconda Ruota",Salvo50,10)
   If R1 <> R2 Then
      BB = CInt(InputBox("Inserisci Il Numero Dell'Estratto Della Seconda Ruota",Salvo50,47))
      If BB = Diametrale(AA) Then
         Clp = InputBox("Per quanti colpi vuoi giocare la quartina?",,13)
         Call ScegliRange(Ini,FIn,Ini,FIn)
         Scrivi Space(8) & "IL RETTANGOLO ASSOLUTO di ANTONIO FIACCO - SCRIPT SALVO50",1,,4,,3,,1
         Scrivi Space(8) & "CON SCELTA RUOTE E NUMERI modifica chiesta da Serpico 90",1,,4,,3,,1
         Posta(2) = 1
         Posta(3) = 1
         'Posta(4) = 1
         For Es = Ini To FIn
            Messaggio Es
            AvanzamentoElab Ini,FIn,Es
            Caso = 0
            For P1 = 1 To 5
               A = Estratto(Es,R1,P1)
               If A = AA Then
                  For P2 = 1 To 5
                     B = Estratto(Es,R2,P2)
                     If B = BB Then
                        For k1 = 1 To 5
                           A1(k1) = Estratto(Es,R1,k1)
                           If A1(k1) = A Then A1(k1) = 0
                        Next
                        Call OrdinaMatrice(A1,1)
                        Dist2A = Distanza(A,A1(2)) : Dist3A = Distanza(A,A1(3))
                        Dist4A = Distanza(A,A1(4)) : Dist5A = Distanza(A,A1(5))
                        '
                        K2 = 0
                        For K2 = 1 To 5
                           B1(K2) = Estratto(Es,R2,K2)
                           If B1(K2) = B Then B1(K2) = 0
                        Next
                        Call OrdinaMatrice(B1,1)
                        Dist2B = Distanza(B,B1(2)) : Dist3B = Distanza(B,B1(3))
                        Dist4B = Distanza(B,B1(4)) : Dist5B = Distanza(B,B1(5))
                        UgA = 0 : UgB = 0
                        If Dist2A = Dist2B Then XA = A1(2) : XB = B1(2) : UgA = Dist2A : UgB = Dist2B
                        If Dist2A = Dist3B Then XA = A1(2) : XB = B1(3) : UgA = Dist2A : UgB = Dist3B
                        If Dist2A = Dist4B Then XA = A1(2) : XB = B1(4) : UgA = Dist2A : UgB = Dist4B
                        If Dist2A = Dist5B Then XA = A1(2) : XB = B1(5) : UgA = Dist2A : UgB = Dist5B
                        '
                        If Dist3A = Dist2B Then XA = A1(3) : XB = B1(2) : UgA = Dist3A : UgB = Dist2B
                        If Dist3A = Dist3B Then XA = A1(3) : XB = B1(3) : UgA = Dist3A : UgB = Dist3B
                        If Dist3A = Dist4B Then XA = A1(3) : XB = B1(4) : UgA = Dist3A : UgB = Dist4B
                        If Dist3A = Dist5B Then XA = A1(3) : XB = B1(5) : UgA = Dist3A : UgB = Dist5B
                        '
                        If Dist4A = Dist2B Then XA = A1(4) : XB = B1(2) : UgA = Dist4A : UgB = Dist2B
                        If Dist4A = Dist3B Then XA = A1(4) : XB = B1(3) : UgA = Dist4A : UgB = Dist3B
                        If Dist4A = Dist4B Then XA = A1(4) : XB = B1(4) : UgA = Dist4A : UgB = Dist4B
                        If Dist4A = Dist5B Then XA = A1(4) : XB = B1(5) : UgA = Dist4A : UgB = Dist5B
                        '
                        If Dist5A = Dist2B Then XA = A1(5) : XB = B1(2) : UgA = Dist5A : UgB = Dist2B
                        If Dist5A = Dist3B Then XA = A1(5) : XB = B1(3) : UgA = Dist5A : UgB = Dist3B
                        If Dist5A = Dist4B Then XA = A1(5) : XB = B1(4) : UgA = Dist5A : UgB = Dist4B
                        If Dist5A = Dist5B Then XA = A1(5) : XB = B1(5) : UgA = Dist5A : UgB = Dist5B
                        If UgA = UgB And UgA > 0 Then
                           Nu1 = 0 : Nu2 = 0 : Nu3 = 0 : Nu4 = 0
                           If XB <> Diametrale(XA) Then
                              If pari(A) And pari(B)Then Call Calcoli(A,B,XA,XB,Nu1,Nu2,Nu3,Nu4)
                              If pari(A) And pari(XB)Then Call Calcoli(A,XB,XA,B,Nu1,Nu2,Nu3,Nu4)
                              If pari(A) And pari(XA)Then Call Calcoli(A,XA,XB,B,Nu1,Nu2,Nu3,Nu4)
                              If dispari(A) And dispari(XB) Then Call Calcoli(A,XB,XA,B,Nu1,Nu2,Nu3,Nu4)
                              If dispari(A) And dispari(B)Then Call Calcoli(A,B,XA,XB,Nu1,Nu2,Nu3,Nu4)
                              If dispari(A) And dispari(XA)Then Call Calcoli(A,XA,B,XB,Nu1,Nu2,Nu3,Nu4)
                              Qua(1) = Nu1 : Qua(2) = Nu2 : Qua(3) = Nu3 : Qua(4) = Nu4
                              Caso = Caso + 1
                              Casi = Casi + 1
                              ColoreTesto 1
                              Scrivi String(89,"o") & " Casi Totali " & FormattaStringa(Casi,"0000")
                              ColoreTesto 2
                              Scrivi String(80,"o") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000")
                              ColoreTesto 0
                              Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
                              Scrivi "  " & SiglaRuota(R1) & "  ",1,0
                              For P5 = 1 To 5
                                 E1 = Estratto(Es,R1,P5)
                                 If E1 = A Then
                                    ColoreTesto 2
                                 Else
                                    ColoreTesto 0
                                 End If
                                 Scrivi Format2(E1) & " ",1,0
                                 ColoreTesto 0
                              Next
                              Scrivi
                              Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
                              Scrivi "  " & SiglaRuota(R2) & "  ",1,0
                              For P6 = 1 To 5
                                 E2 = Estratto(Es,R2,P6)
                                 If E2 = B Then
                                    ColoreTesto 2
                                 Else
                                    ColoreTesto 0
                                 End If
                                 Scrivi Format2(E2) & " ",1,0
                                 ColoreTesto 0
                              Next
                              Scrivi
                              Scrivi
                              Scrivi Space(5) & Format2(A) & "-" & Format2(A1(2)) & " = Distanza " & Format2(Dist2A),1,0
                              Scrivi Space(10) & Format2(B) & "-" & Format2(B1(2)) & " = Distanza " & Format2(Dist2B),1
                              Scrivi Space(5) & Format2(A) & "-" & Format2(A1(3)) & " = Distanza " & Format2(Dist3A),1,0
                              Scrivi Space(10) & Format2(B) & "-" & Format2(B1(3)) & " = Distanza " & Format2(Dist3B),1
                              Scrivi Space(5) & Format2(A) & "-" & Format2(A1(4)) & " = Distanza " & Format2(Dist4A),1,0
                              Scrivi Space(10) & Format2(B) & "-" & Format2(B1(4)) & " = Distanza " & Format2(Dist4B),1
                              Scrivi Space(5) & Format2(A) & "-" & Format2(A1(5)) & " = Distanza " & Format2(Dist5A),1,0
                              Scrivi Space(10) & Format2(B) & "-" & Format2(B1(5)) & " = Distanza " & Format2(Dist5B),1
                              Scrivi
                              Scrivi Space(17) & " La Distanza Uguale è " & Format2(UgA),1
                              Scrivi Space(17) & "Pronostico   " & StringaNumeri(Qua," ",True),1
                              Ruo(1) = R1 : Ruo(2) = R2
                              ImpostaGiocata 1,Qua,Ruo,Posta,Clp
                              Gioca Es
                           End If
                        End If
                     End If
                  Next
               End If
            Next
            If ScriptInterrotto Then Exit Sub
         Next
         ScriviResoconto
      End If
      If AA <> Diametrale(BB) Then Scrivi " I NUMERI INSERITI NON SONO DIAMETRALI",1,,,2
   End If
   If R1 = R2 Then Scrivi " HAI INSERITO 2 RUOTE UGUALI",1,,,2
End Sub
Function Calcoli(N1,N2,N3,N4,Nu1,Nu2,Nu3,Nu4)
   Nu1 =((N1 + N2)\ 2)
   Nu2 = Diametrale(Nu1)
   Nu3 =((N3 + N4)\ 2)
   Nu4 = Diametrale(Nu3)
End Function
Clicca per espandere...
Grazie Salvo Domani passero il tempo ad analizzare il nuovo script ....
sperando di poter trovare delle buone previsioni che condividerò .......
sempre grato della tua disponibilità, ti auguro una buona serata
Saluti
Serpico
 
Serpico 90 ha scritto:
Grazie Salvo Domani passero il tempo ad analizzare il nuovo script ....
sperando di poter trovare delle buone previsioni che condividerò .......
sempre grato della tua disponibilità, ti auguro una buona serata
Saluti
Serpico
Clicca per espandere...
Buon giorno Salvo .......ti chiedo scusa ..sto facendo diverse prove con linserimento di dati di diverse estrazioni ma purtroppo
non mi da nessuna previsione,......alcuni chiarimenti ......i numeri che inserisco devono essere per forza ISOTOPI ?
POI la ruota nazionale e consiserata e la indico con il n.12???
ti invio per tu verific diverse estrazioni che ho inserito ,tra l'altro sono tutti numeri diametrali tra di loro con somma 45 simili a quelli che ricerca nello script originale ,e possibile che tra tutti questi inserimenti non mi da neppura una previsione?
questi i concorsi, appena puoi e hai tempo cortesemente puoi verificare?
9739 25.gen. 7 pa 50 12 naz.... 5
9739 25.gen 8 ro 38 12 naz. 83
9743 4.feb...........3 fi 60 8 ro 15..
9748 15.2 4 ge 16 9 to 61
Queste alcune date se cortesemente puoi verificare -....ve ne sono altre tutte senza previsioni ........
Sempre grato delle tue attenzioni auguro buon pranzo
Saluti
Serpico
 
Serpico 90 ha scritto:
Buon giorno Salvo .......ti chiedo scusa ..sto facendo diverse prove con linserimento di dati di diverse estrazioni ma purtroppo
non mi da nessuna previsione,......alcuni chiarimenti ......i numeri che inserisco devono essere per forza ISOTOPI ?
POI la ruota nazionale e consiserata e la indico con il n.12???
ti invio per tu verific diverse estrazioni che ho inserito ,tra l'altro sono tutti numeri diametrali tra di loro con somma 45 simili a quelli che ricerca nello script originale ,e possibile che tra tutti questi inserimenti non mi da neppura una previsione?
questi i concorsi, appena puoi e hai tempo cortesemente puoi verificare?
9739 25.gen. 7 pa 50 12 naz.... 5
9739 25.gen 8 ro 38 12 naz. 83
9743 4.feb...........3 fi 60 8 ro 15..
9748 15.2 4 ge 16 9 to 61
Queste alcune date se cortesemente puoi verificare -....ve ne sono altre tutte senza previsioni ........
Sempre grato delle tue attenzioni auguro buon pranzo
Saluti
Serpico
Clicca per espandere...
Ciao a Tutti.

Ciao Serpico, i numeri inseriti possono essere anche non isotopi, per la ruota Nazionale metti 12.

Nel metodo postato da Matematico oltre alla condizione di diametralità degli estratti utili, ci sono altre due condizioni, se non esce niente nell'output è perchè una o tutte e due queste condizioni non sono rispettate, nel post 387 ho messo un'altro script nel quale ho tolto le due condizioni che sono

1) DISTANZA UGUALE
2) DIAMETRALITA' TRA I NUMERI DELLE COPPIE UGUALI

Togliendo queste condizioni non è più il metodo di A. Fiacco

sicuramente i calcoli verranno fatti tra numeri degli estratti e numeri zero
può anche succederte che esca qualcosa, ma non perchè il metodo funziona

Nello script le condizioni li ho tolti con l'apice, se hai un po' di dimestichezza puoi fare delle prove anche inserendole.
 
Ultima modifica:
salvo50 ha scritto:
Ciao a Tutti.

Ciao Serpico, i numeri inseriti possono essere anche non isotopi, per la ruota Nazionale metti 12.

Nel metodo postato da Matematico oltre alla condizione di diametralità degli estratti utili, ci sono altre due condizioni, se non esce niente nell'output è perchè una o tutte e due queste condizioni non sono rispettate, nel post 387 ho messo un'altro script nel quale ho tolto le due condizioni che sono

1) DISTANZA UGUALE
2) DIAMETRALITA' TRA I NUMERI DELLE COPPIE UGUALI

Togliendo queste condizioni non è più il metodo di A. Fiacco

sicuramente i calcoli verranno fatti tra numeri degli estratti e numeri zero
può anche succederte che esca qualcosa, ma non perchè il metodo funziona

Nello script le condizioni li ho tolti con l'apice, se hai un po' di dimestichezza puoi fare delle prove anche inserendole.
Clicca per espandere...
Grazie Salvo........
come al solito sempre disponibile......
saluti
Serpico
 
Serpico 90 ha scritto:
Ciao A tutti,,,,,
Chiedo cortesemente a Salvo se per caso ,sempre con i suoi tempi e la sua grande disponibilità se ha sviluppato uno script indicato da Matematico " Alta Ciclometria" di Franco Mogillo ....
Un grande ringraziamento tutti voi e in special modo Salvo per la sua maestria a creare questi ottimo script
Saluti
Serpico
Clicca per espandere...
Da questo procedimento, la previsione del 03/12/2020 su GE PA ha dato al 1°
Ambata 73 + Terno 28.62.73 su GE

Complimenti all'Autore.

Enplein.
 
Enplein ha scritto:
Da questo procedimento, la previsione del 03/12/2020 su GE PA ha dato al 1°
Ambata 73 + Terno 28.62.73 su GE

Complimenti all'Autore.

Enplein.
Clicca per espandere...
Ciao a Tutti.

Ciao Enplein

Nello script che ho fatto io (non l'ho postato perchè non è ancora perfetto) basi maggiori e minori dispari, ho una previsione del 1-12-20 PA-TO al 2° colpo Torino,
ambata 66
e terno a ruota
3-66-30

confermi?
 
salvo50 ha scritto:
Ciao Enplein, l'autore è Franco Mongillo.

Se hai fatto lo script, potresti postarlo.
Clicca per espandere...
Buongiorno.

Questo lavoro è stato trattato nel 2011 sul mio Forum, con la collaborazione
di Joe, che saluto, con tutte le spiegazioni del caso.
Inizialmente lo script era X Lottodesk e trasformato x Spaziometria inserendo
la funzione DisegnaCerchioCiclometrico(numeri)

Allego lo script che gira su Spaziometria.
Sub Main()
'dichiaro le variabili
Dim num(6)
Dim ruote(2),rtt(1)
Dim n(4),nr(4),amb(1),lg(5),rt(1),ab1(2),ab2(2),ab3(2),ab4(2)
Dim posta(1),poste1(3),poste2(4)
posta(1)=1: poste1(2)=1.50:poste1(3)=.50
poste2(3)=1.50: poste2(4)=0.50
'considero le ultime 100 estrazioni
rs=InputBox("Quante estrazioni vuoi controllare?","F.F.",100)
ini=EstrazioneFin -rs
fin=EstrazioneFin
'--------------------------------------------------------------------------------
Scrivi
Scrivi
ColoreTesto 2
Scrivi String(45," ")&"****** (By F. Mongillo) ****** ",1
Scrivi String(40," ")&" COME VINCERE LA QUATERNA ",1
Scrivi String(42," ")&"****** 1a PARTE & 2a PARTE ****** Listed by Enplein ",1
Scrivi
ColoreTesto 0
Scrivi String(50," ")&"****** Rendiconto ****** ",1
Scrivi String(50," ")& DataEstrazione(ini)&" - "& DataEstrazione(fin)
Scrivi
'------------------------------------------------------------
t=0 'inizializza la variabile delle giocate.
For es=ini To fin
Messaggio "Estrazione esaminata: " & CStr(es) 'per sapere a che punto stò
'ricerco le condizioni per il gioco
For r1= 1 To 10
For p= 1 To 4
For pp=p+1 To 5
a=Estratto(es,r1,p) : b=Estratto(es,r1,pp)
dso1=Distanza (a,b)
For r2=r1+1 To 11
If r2=11 Then r2=12
c=Estratto(es,r2,p) : d=Estratto(es,r2,pp)
dso2=Distanza (c,d):smv1=Fuori90 (a+c):smv2=Fuori90 (b+d)
dsd1=Distanza (a,d):dsd2=Distanza (b,c)
If a<>c And a<>d And b<>c And b<>d Then
If dso1=dso2 And dsd1=dsd2 And smv1=smv2 Then
n(1)=a: n(2)=b : n(3)=c: n(4)=d
OrdinaMatrice n,1


'-------------------------------------------------------------------------------
ok=0
df1=Fuori90 ((n(2)+90)-n(1)): df2=Fuori90 ((n(3)+90)-n(2))
df3=Fuori90 ((n(4)+90)-n(3)): df4=Fuori90 ((n(1)+90)-n(4))
If df1=df3 And df2<df4 Then nr(1)=n(1):nr(2)=n(2):nr(3)=n(3):nr(4)=n(4) : ok=1 : dx1=df1
If df1=df3 And df2>df4 Then nr(1)=n(3):nr(2)=n(4):nr(3)=n(1):nr(4)=n(2) : ok=1 : dx1=df1
If df2=df4 And df1<df3 Then nr(1)=n(2):nr(2)=n(3):nr(3)=n(4):nr(4)=n(1) : ok=1 : dx1=df2
If df2=df4 And df1>df3 Then nr(1)=n(4):nr(2)=n(1):nr(3)=n(2):nr(4)=n(3) : ok=1 : dx1=df2
If ok=1 Then
bs2=Fuori90 ((nr(1)+90)-nr(4))
'-------------------------------------------------------------------------------
'Quadratura delle Distanze e delle Somme con i numeri ordinati
do1=Distanza (nr(1),nr(2)) : do2=Distanza (nr(3),nr(4))
dv1=Distanza (nr(1),nr(4)) : dv2=Distanza (nr(2),nr(3))'Base minore
dd1=Distanza (nr(1),nr(3)) : dd2=Distanza (nr(2),nr(4))
So1=Fuori90 (nr(1)+nr(2)) : So2=Fuori90 (nr(3)+nr(4))
Sv1=Fuori90 (nr(1)+nr(4)) : Sv2=Fuori90 (nr(2)+nr(3))
Sd1=Fuori90 (nr(1)+nr(3)) : Sd2=Fuori90 (nr(2)+nr(4))
'rileva la condizione, se e' verificata imposta le giocate
If (pari (smv1)=False ) Or (pari (smv1)=True ) Then
ok1=0 : ok2=0
'Calcolo x trovare la chiusura di figura
If pari (smv1)=False And dx1<bs2 Then
nu1=Fuori90 ((nr(1)+90)-do1): nu2=Fuori90 (nr(4)+do1)
sdx1=Fuori90 (do1+do1+dv2)
bs1=Distanza (nu1,nu2)
sdx2=Fuori90 (do1+do1+bs1)
If sdx1+sdx2=90 Then
ok1=1
End If
End If
If pari (smv1)=True And pari (dx1)=True Then
nu1=Fuori90 (nr(1)+(dx1/2)) : nu2=Fuori90 (nr(3)+(dx1/2))
sx=do1+do2+bs2+dv2
If sx=90 Then
ok2=1
End If
End If
If ok1=1 Or ok2=1 Then
nu3=Trasposizione (nu1,nu2):nu4=Trasposizione (nu2,nu1)
nu5=Fuori90 ( Cadenza (nu4)& Decina (nu3))
nu6=Fuori90 ( Cadenza (nu3)& Decina (nu4))

'Previsione
amb(1)=Diametrale (Abs (nu3-nu4))
lg(1)=amb(1):lg(2)=nu3:lg(3)=nu4:lg(4)=nu5:lg(5)=nu6
'Controlla se ci sono elementi ripetuti
g=0
For i=1 To 4 : For j=i+1 To 5
If lg(i)=lg(j) Then
g=g+1
End If
Next : Next
If g=0 Then
t=t+1 'incrementa la variabile delle giocate.
ruote(1)=r1:ruote(2)=r2:rtt(1)=11
Scrivi
Scrivi "-----------------------------------------------------------------------------------------------------------------------------"
ColoreTesto 1
Scrivi Space (53)&"QUADRATURA"& Space (3)&"Distanze"& Space (21)&"Somme",1
ColoreTesto 0
Scrivi DataEstrazione(es) &" "& SiglaRuota (r1)&" "& StringaEstratti (es,r1) & " " & Format2 (a) &" "& Format2 (b)&_
" = "& Format2 (dso1)&" Dist. Oriz."& " " & Format2 (nr(1)) &" "& Format2 (nr(2))&_
" [Do1 "& Format2(do1)&" Dv1 "& Format2(dv1)&_
" Dd1 "& Format2(dd1)&_
"] [So1 "& Format2(so1)&" Sv1 "& Format2(sv1)&" Sd1 "& Format2(sd1)&"]" & Chr (10)&_
Space (33)&"X = "& Format2 (dsd1)&" Dist. Diag."& Chr (10) &_
Space(11)& SiglaRuota (r2)&" "& StringaEstratti (es,r2) & " " & Format2 (c) &" "& Format2 (d)&_
" = "& Format2 (dso2)&" Dist. Oriz."& " " & Format2 (nr(4)) &" "& Format2 (nr(3))&_
" [Do2 "& Format2(do2)&" Dv2 "& Format2(dv2)&_
" Dd2 "& Format2(dd2)&_
"] [So2 "& Format2(so2)&" Sv2 "& Format2(sv2)&" Sd2 "& Format2(sd2)&"]"& Chr (10)&_
Space (31)&" = ="& Chr (10)&_
Space (31)& Format2 (smv1)&" "& Format2 (smv2)&" Som. Vert.",1
If ok1=1 Then
ColoreTesto 1
Scrivi "1° procedimento"& Chr (10)&_
Space (13)& Format2 (nr(2))& Space (2)&"("& Format2 (dv2)&")"& Space (2)& Format2 (nr(3))& Chr (10) &_
Space (10)&"("& Format2 (do1)&")"& Space (10) &"("& Format2 (do2)&")"& Chr (10) &_
Space (8)& Format2 (nr(1))& Space (18)& Format2 (nr(4))& Chr (10)&_
Space (10)&"("& Format2 (do1)&")"& Space (10) &"("& Format2 (do2)&")"& Chr (10) &_
Space (13)& Format2 (nu1)& Space (2)&"("& Format2 (bs1)&")"& Space (2)& Format2 (nu2)& Chr (10),1
ColoreTesto 0
Scrivi "Numeri ordinati crescenti: " & StringaNumeri (nr)&" Chius. Figura "& Format2 (nu1)&"."& Format2 (nu2)&_
" Som. lati "& Format2 (sdx1)&" / "& Format2 (sdx2),1
End If
If ok2=1 Then
ColoreTesto 1
Scrivi "2° procedimento"& Chr (10)&_
Space (16)& Format2 (nr(2))& Space (2)&"("& Format2 (dv2)&")"& Space (2)& Format2 (nr(3))& Chr (10) &_
Space (9)& Format2 (nu1)& Space (1)&"("& Format2 (do1)&")"& Space (11)&"("& Format2 (do2)&")"& Space (1)& Format2 (nu2)& Chr (10)&_
Space (10)& Format2 (nr(1))& Space (8)&"("& Format2 (dv1)&")"& Space (6)& Format2 (nr(4))& Chr (10),1
ColoreTesto 0
Scrivi "Numeri ordinati crescenti: " & StringaNumeri (nr)&" Chius. Figura "& Format2 (nu1)&"."& Format2 (nu2)&_
" Som. lati "& Format2 (sx),1
End If
Scrivi
Scrivi"--------------------------------------------------------------------------------------------------------"& "Giocata n° "& Format2(t)
num(1)=nr(1):num(2)=nr(2):num(3)=nr(3):num(4)=nr(4):num(5)=nu1:num(6)=nu2
DisegnaCerchioCiclometrico num,True
ImpostaGiocata 1,amb,ruote,posta,12,1
ImpostaGiocata 2,lg,ruote,poste1,12,3
ImpostaGiocata 3,lg,rtt,poste2,12,3
'esegue la giocata
Gioca es
End If

End If
End If
End If
End If
End If
Next
Next
Next
Next
Next
ScriviResoconto
ColoreTesto 1
Scrivi String(70,"=")&"listato da franco florindi",1
ColoreTesto 0
End Sub
 
Enplein ha scritto:
Buongiorno.

Questo lavoro è stato trattato nel 2011 sul mio Forum, con la collaborazione
di Joe, che saluto, con tutte le spiegazioni del caso.
Inizialmente lo script era X Lottodesk e trasformato x Spaziometria inserendo
la funzione DisegnaCerchioCiclometrico(numeri)

Allego lo script che gira su Spaziometria.
Sub Main()
'dichiaro le variabili
Dim num(6)
Dim ruote(2),rtt(1)
Dim n(4),nr(4),amb(1),lg(5),rt(1),ab1(2),ab2(2),ab3(2),ab4(2)
Dim posta(1),poste1(3),poste2(4)
posta(1)=1: poste1(2)=1.50:poste1(3)=.50
poste2(3)=1.50: poste2(4)=0.50
'considero le ultime 100 estrazioni
rs=InputBox("Quante estrazioni vuoi controllare?","F.F.",100)
ini=EstrazioneFin -rs
fin=EstrazioneFin
'--------------------------------------------------------------------------------
Scrivi
Scrivi
ColoreTesto 2
Scrivi String(45," ")&"****** (By F. Mongillo) ****** ",1
Scrivi String(40," ")&" COME VINCERE LA QUATERNA ",1
Scrivi String(42," ")&"****** 1a PARTE & 2a PARTE ****** Listed by Enplein ",1
Scrivi
ColoreTesto 0
Scrivi String(50," ")&"****** Rendiconto ****** ",1
Scrivi String(50," ")& DataEstrazione(ini)&" - "& DataEstrazione(fin)
Scrivi
'------------------------------------------------------------
t=0 'inizializza la variabile delle giocate.
For es=ini To fin
Messaggio "Estrazione esaminata: " & CStr(es) 'per sapere a che punto stò
'ricerco le condizioni per il gioco
For r1= 1 To 10
For p= 1 To 4
For pp=p+1 To 5
a=Estratto(es,r1,p) : b=Estratto(es,r1,pp)
dso1=Distanza (a,b)
For r2=r1+1 To 11
If r2=11 Then r2=12
c=Estratto(es,r2,p) : d=Estratto(es,r2,pp)
dso2=Distanza (c,d):smv1=Fuori90 (a+c):smv2=Fuori90 (b+d)
dsd1=Distanza (a,d):dsd2=Distanza (b,c)
If a<>c And a<>d And b<>c And b<>d Then
If dso1=dso2 And dsd1=dsd2 And smv1=smv2 Then
n(1)=a: n(2)=b : n(3)=c: n(4)=d
OrdinaMatrice n,1


'-------------------------------------------------------------------------------
ok=0
df1=Fuori90 ((n(2)+90)-n(1)): df2=Fuori90 ((n(3)+90)-n(2))
df3=Fuori90 ((n(4)+90)-n(3)): df4=Fuori90 ((n(1)+90)-n(4))
If df1=df3 And df2<df4 Then nr(1)=n(1):nr(2)=n(2):nr(3)=n(3):nr(4)=n(4) : ok=1 : dx1=df1
If df1=df3 And df2>df4 Then nr(1)=n(3):nr(2)=n(4):nr(3)=n(1):nr(4)=n(2) : ok=1 : dx1=df1
If df2=df4 And df1<df3 Then nr(1)=n(2):nr(2)=n(3):nr(3)=n(4):nr(4)=n(1) : ok=1 : dx1=df2
If df2=df4 And df1>df3 Then nr(1)=n(4):nr(2)=n(1):nr(3)=n(2):nr(4)=n(3) : ok=1 : dx1=df2
If ok=1 Then
bs2=Fuori90 ((nr(1)+90)-nr(4))
'-------------------------------------------------------------------------------
'Quadratura delle Distanze e delle Somme con i numeri ordinati
do1=Distanza (nr(1),nr(2)) : do2=Distanza (nr(3),nr(4))
dv1=Distanza (nr(1),nr(4)) : dv2=Distanza (nr(2),nr(3))'Base minore
dd1=Distanza (nr(1),nr(3)) : dd2=Distanza (nr(2),nr(4))
So1=Fuori90 (nr(1)+nr(2)) : So2=Fuori90 (nr(3)+nr(4))
Sv1=Fuori90 (nr(1)+nr(4)) : Sv2=Fuori90 (nr(2)+nr(3))
Sd1=Fuori90 (nr(1)+nr(3)) : Sd2=Fuori90 (nr(2)+nr(4))
'rileva la condizione, se e' verificata imposta le giocate
If (pari (smv1)=False ) Or (pari (smv1)=True ) Then
ok1=0 : ok2=0
'Calcolo x trovare la chiusura di figura
If pari (smv1)=False And dx1<bs2 Then
nu1=Fuori90 ((nr(1)+90)-do1): nu2=Fuori90 (nr(4)+do1)
sdx1=Fuori90 (do1+do1+dv2)
bs1=Distanza (nu1,nu2)
sdx2=Fuori90 (do1+do1+bs1)
If sdx1+sdx2=90 Then
ok1=1
End If
End If
If pari (smv1)=True And pari (dx1)=True Then
nu1=Fuori90 (nr(1)+(dx1/2)) : nu2=Fuori90 (nr(3)+(dx1/2))
sx=do1+do2+bs2+dv2
If sx=90 Then
ok2=1
End If
End If
If ok1=1 Or ok2=1 Then
nu3=Trasposizione (nu1,nu2):nu4=Trasposizione (nu2,nu1)
nu5=Fuori90 ( Cadenza (nu4)& Decina (nu3))
nu6=Fuori90 ( Cadenza (nu3)& Decina (nu4))

'Previsione
amb(1)=Diametrale (Abs (nu3-nu4))
lg(1)=amb(1):lg(2)=nu3:lg(3)=nu4:lg(4)=nu5:lg(5)=nu6
'Controlla se ci sono elementi ripetuti
g=0
For i=1 To 4 : For j=i+1 To 5
If lg(i)=lg(j) Then
g=g+1
End If
Next : Next
If g=0 Then
t=t+1 'incrementa la variabile delle giocate.
ruote(1)=r1:ruote(2)=r2:rtt(1)=11
Scrivi
Scrivi "-----------------------------------------------------------------------------------------------------------------------------"
ColoreTesto 1
Scrivi Space (53)&"QUADRATURA"& Space (3)&"Distanze"& Space (21)&"Somme",1
ColoreTesto 0
Scrivi DataEstrazione(es) &" "& SiglaRuota (r1)&" "& StringaEstratti (es,r1) & " " & Format2 (a) &" "& Format2 (b)&_
" = "& Format2 (dso1)&" Dist. Oriz."& " " & Format2 (nr(1)) &" "& Format2 (nr(2))&_
" [Do1 "& Format2(do1)&" Dv1 "& Format2(dv1)&_
" Dd1 "& Format2(dd1)&_
"] [So1 "& Format2(so1)&" Sv1 "& Format2(sv1)&" Sd1 "& Format2(sd1)&"]" & Chr (10)&_
Space (33)&"X = "& Format2 (dsd1)&" Dist. Diag."& Chr (10) &_
Space(11)& SiglaRuota (r2)&" "& StringaEstratti (es,r2) & " " & Format2 (c) &" "& Format2 (d)&_
" = "& Format2 (dso2)&" Dist. Oriz."& " " & Format2 (nr(4)) &" "& Format2 (nr(3))&_
" [Do2 "& Format2(do2)&" Dv2 "& Format2(dv2)&_
" Dd2 "& Format2(dd2)&_
"] [So2 "& Format2(so2)&" Sv2 "& Format2(sv2)&" Sd2 "& Format2(sd2)&"]"& Chr (10)&_
Space (31)&" = ="& Chr (10)&_
Space (31)& Format2 (smv1)&" "& Format2 (smv2)&" Som. Vert.",1
If ok1=1 Then
ColoreTesto 1
Scrivi "1° procedimento"& Chr (10)&_
Space (13)& Format2 (nr(2))& Space (2)&"("& Format2 (dv2)&")"& Space (2)& Format2 (nr(3))& Chr (10) &_
Space (10)&"("& Format2 (do1)&")"& Space (10) &"("& Format2 (do2)&")"& Chr (10) &_
Space (8)& Format2 (nr(1))& Space (18)& Format2 (nr(4))& Chr (10)&_
Space (10)&"("& Format2 (do1)&")"& Space (10) &"("& Format2 (do2)&")"& Chr (10) &_
Space (13)& Format2 (nu1)& Space (2)&"("& Format2 (bs1)&")"& Space (2)& Format2 (nu2)& Chr (10),1
ColoreTesto 0
Scrivi "Numeri ordinati crescenti: " & StringaNumeri (nr)&" Chius. Figura "& Format2 (nu1)&"."& Format2 (nu2)&_
" Som. lati "& Format2 (sdx1)&" / "& Format2 (sdx2),1
End If
If ok2=1 Then
ColoreTesto 1
Scrivi "2° procedimento"& Chr (10)&_
Space (16)& Format2 (nr(2))& Space (2)&"("& Format2 (dv2)&")"& Space (2)& Format2 (nr(3))& Chr (10) &_
Space (9)& Format2 (nu1)& Space (1)&"("& Format2 (do1)&")"& Space (11)&"("& Format2 (do2)&")"& Space (1)& Format2 (nu2)& Chr (10)&_
Space (10)& Format2 (nr(1))& Space (8)&"("& Format2 (dv1)&")"& Space (6)& Format2 (nr(4))& Chr (10),1
ColoreTesto 0
Scrivi "Numeri ordinati crescenti: " & StringaNumeri (nr)&" Chius. Figura "& Format2 (nu1)&"."& Format2 (nu2)&_
" Som. lati "& Format2 (sx),1
End If
Scrivi
Scrivi"--------------------------------------------------------------------------------------------------------"& "Giocata n° "& Format2(t)
num(1)=nr(1):num(2)=nr(2):num(3)=nr(3):num(4)=nr(4):num(5)=nu1:num(6)=nu2
DisegnaCerchioCiclometrico num,True
ImpostaGiocata 1,amb,ruote,posta,12,1
ImpostaGiocata 2,lg,ruote,poste1,12,3
ImpostaGiocata 3,lg,rtt,poste2,12,3
'esegue la giocata
Gioca es
End If

End If
End If
End If
End If
End If
Next
Next
Next
Next
Next
ScriviResoconto
ColoreTesto 1
Scrivi String(70,"=")&"listato da franco florindi",1
ColoreTesto 0
End Sub
Clicca per espandere...
Grazie Enplein , complimenti , un bellissimo lavoro e peccato che ci siamo persi un terno in cinquina....vabbè
 
salvo50 ha scritto:
Ciao a Tutti.

Ciao Enplein

Nello script che ho fatto io (non l'ho postato perchè non è ancora perfetto) basi maggiori e minori dispari, ho una previsione del 1-12-20 PA-TO al 2° colpo Torino,
ambata 66
e terno a ruota
3-66-30

confermi?
Clicca per espandere...
Ciao salvo50, nello script di enplein non c'è questa condizione di gioco e quindi l'elaborato è diverso ma a quanto pare efficace , aspettiamo anche il tuo script
 
Ultima modifica:
Devi accedere o registrarti per poter rispondere.

Ultima estrazione Lotto

  • Estrazione del lotto
    martedì 26 novembre 2024
    Bari
    35
    16
    24
    41
    85
    Cagliari
    89
    30
    10
    81
    72
    Firenze
    38
    60
    16
    13
    28
    Genova
    52
    15
    80
    08
    53
    Milano
    33
    77
    06
    54
    73
    Napoli
    01
    50
    64
    35
    36
    Palermo
    02
    01
    19
    33
    62
    Roma
    33
    48
    72
    47
    68
    Torino
    62
    28
    18
    75
    31
    Venezia
    03
    54
    27
    14
    71
    Nazionale
    02
    44
    27
    86
    78
    Estrazione Simbolotto
    Torino
    30
    07
    39
    14
    19
    Archivio estrazioni lotto Ritardi top 15 Frequenze top 15

Ultimi Messaggi

Indietro
Alto