Richiesta script x spaziometria

[Dragon zf]

Questo e' il metodo.Grazie.

 

[Dragon zf]

Ovviamente prendendo in considerazione tutte le figure.

 

[AlessandroPe74]

' =================================================================================
' Script: Ricerca Automatica Trapezio Ciclometrico (Tutte le Ruote)
' Note: Il listato scansiona automaticamente tutte le ruote per individuare
' la condizione del trapezio e calcolare lo sviluppo ciclometrico.
' =================================================================================

Option Explicit

Sub Main()
Dim idEstr As Long
Dim r1, r2 As Integer
Dim aNum(4) As Integer
Dim d1, d2, d3, d4 As Integer
Dim nEstrInizio As Long
Dim aTuttiNumeri(10) As Integer

' Imposta l'archivio da analizzare (es. ultime 50 estrazioni per velocità)
nEstrInizio = EstrazioniArchivio - 50

Call Scrivi("Ricerca Automatica Trapezio Ciclometrico - Tutte le Ruote")
Call Scrivi("----------------------------------------------------------------------")

For idEstr = nEstrInizio To EstrazioniArchivio

' Ciclo automatico su tutte le ruote (1=Bari ... 12=Nazionale)
For r1 = 1 To 12
For r2 = r1 + 1 To 12

Call GetNumeriUniti(idEstr, r1, r2, aTuttiNumeri)

' Analisi delle combinazioni di 4 numeri sui 10 totali delle due ruote
Dim i, j, l, m As Integer
For i = 0 To 7
For j = i + 1 To 8
For l = j + 1 To 9
For m = l + 1 To 10
' Selezione dei 4 numeri
aNum(1) = aTuttiNumeri(i)
aNum(2) = aTuttiNumeri(j)
aNum(3) = aTuttiNumeri(l)
aNum(4) = aTuttiNumeri(m)

Call OrdinaMatrice(aNum, 1)

' Calcolo distanze ciclometriche
d1 = DistanzaCiclometrica(aNum(1), aNum(2))
d2 = DistanzaCiclometrica(aNum(2), aNum(3))
d3 = DistanzaCiclometrica(aNum(3), aNum(4))
d4 = DistanzaCiclometrica(aNum(4), aNum(1))

' Verifica condizione Trapezio
If VerificaStrutturaTrapezio(d1, d2, d3, d4) Then
Call Scrivi("--------------------------------------------------")
Call Scrivi("Trovata condizione in data: " & GetInfoEstrazione(idEstr))
Call Scrivi("Ruote: " & NomeRuota(r1) & " - " & NomeRuota(r2))
Call Scrivi("Numeri (Trapezio): " & StringaNumeri(aNum))
Call Scrivi("Distanze: " & d1 & "-" & d2 & "-" & d3 & "-" & d4)
Call CalcolaSviluppoCiclometrico(aNum)
End If
Next
Next
Next
Next

Next
Next
Call AvanzamentoElab(nEstrInizio, EstrazioniArchivio, idEstr)
If ScriptInterrotto Then Exit For
Next

Call Scrivi("Ricerca completata.")
End Sub

Function VerificaStrutturaTrapezio(d1, d2, d3, d4) As Boolean
Dim aD(4)
aD(1) = d1 : aD(2) = d2 : aD(3) = d3 : aD(4) = d4
Call OrdinaMatrice(aD, 1)

' Condizione di geometria: i tre lati minori sono uguali
If (aD(1) = aD(2) And aD(2) = aD(3)) Or (aD(2) = aD(3) And aD(3) = aD(4)) Then
VerificaStrutturaTrapezio = True
Else
VerificaStrutturaTrapezio = False
End If
End Function

Sub CalcolaSviluppoCiclometrico(aNumeri)
Dim nEstratto1, nEstratto2, nAmbo1, nAmbo2, nAmbo3

' Sviluppo ciclometrico puro (Somme e chiusure geometriche)
nEstratto1 = Fuori90(aNumeri(1) + aNumeri(4))
nEstratto2 = Fuori90(aNumeri(2) + aNumeri(3))

nAmbo1 = aNumeri(1)
nAmbo2 = aNumeri(3)
nAmbo3 = Fuori90(nEstratto1 + nEstratto2 + aNumeri(2))

Call Scrivi("Previsione Sviluppo Ciclometrico:")
Call Scrivi("Estratti: " & nEstratto1 & " - " & nEstratto2)
Call Scrivi("Ambo e Terno: " & nAmbo1 & "." & nAmbo2 & "." & nAmbo3)
End Sub

Sub GetNumeriUniti(idEstr, r1, r2, aTuttiNumeri)
Dim k, x
x = 0
For k = 1 To 5
aTuttiNumeri(x) = Estratto(idEstr, r1, k)
x = x + 1
Next
For k = 1 To 5
aTuttiNumeri(x) = Estratto(idEstr, r2, k)
x = x + 1
Next
End Sub