10elotto

[Zetrix]

Alien ecco il disegno sembra un aquilone anzi e un aquilone adesso non considerare la dist 8
perche la dist e 2 devi fare 10-8=2 perche qui la dist massima e 5
invece lo 0 corrisponde al 90
come si nota nel disegno abbiamo l'ambo diam.4,9

 

[Zetrix]

Option Explicit
Class clsCerchioCiclometrico
   Dim aPos(90,2) ' memorizza le coordinate relative ai 90 numeri
   Private CollCorde
   Sub DisegnaCerchioCiclometricoX(aNumeri,aCorde)
      Dim nRaggio ' raggio ddel cerchio
      Dim cX,cY ' centro del cerchio x e y
      Dim Base,Altezza ' dimensioni area disegno
      Dim Angolo ' gestisce il ciclo per disegnare il cerchio
      Dim pi ' pigreco
      Dim x1,y1,x2,y2 ' coordinate generiche pr i segmenti
      Dim cLung ' distanza per stampare i gradi
      Dim k ' ciclo generico
      Dim n
      Dim z
      Call PicClear
      Set CollCorde = GetNewCollection
      cLung = 2
      pi = 3.14
      Base = 150
      Altezza = 150
      nRaggio = 60
      ' preimposto le dimensioni dell'area
      Call PicSetDimensioni(Base,Altezza,Base,Altezza)
      ' calcolo il centro del cerchio
      cX = Base / 2
      cY = Altezza / 2
      Call PicCerchio(cX,cY,nRaggio)
      Angolo = 360
      n = 10 '<---------------------------------
      ' ciclo per disegnare i semiraggi
      For z = 90 To 450 Step 36 '<----------------------------------
         Angolo = FuoriX(z,360)
         ' calcolo cordinate per il segmento raggio
         x1 = cX +((nRaggio) * Cos(- Angolo *(pi / 180)))
         y1 = cY +((nRaggio) * Sin(- Angolo *(pi / 180)))
         ' memorizzo nell'array globale le coordinate appena calcolate
         ' cosi potranno essere riusate per disegnare le corde
         n = n - 1
         aPos(n,1) = x1
         aPos(n,2) = y1
         If n Mod 10 = 0 Or n Mod 10 = 1 Or n Mod 10 = 2 Or n Mod 10 = 3 Or n Mod 10 = 4 Or n Mod 10 = 5 Or n Mod 10 = 6 Or n Mod 10 = 7 Or n Mod 10 = 8 Or n Mod 10 = 9 Then '<--------------------------
            ' ogni 5 gradi disegno un semiraggio un po' piu lungo
            ' e stampo i gradi in corripondenza
            x2 = cX +((nRaggio + cLung*3) * Cos(- Angolo *(pi / 180)))
            y2 = cY +((nRaggio + cLung*3) * Sin(- Angolo *(pi / 180)))
            Call PicLinea(x1,y1,x2,y2)
            x2 = cX +((nRaggio + cLung*4) * Cos(-(Angolo + 2) *(pi / 180)))
            y2 = cY +((nRaggio + cLung*4) * Sin(-(Angolo + 2) *(pi / 180)))
            Call PicStampaTestoRT(x2,y2,n,Angolo)
         Else
            ' disegno il semiraggio
            x2 = cX +((nRaggio + cLung) * Cos(- Angolo *(pi / 180)))
            y2 = cY +((nRaggio + cLung) * Sin(- Angolo *(pi / 180)))
            Call PicLinea(x1,y1,x2,y2)
            x2 = cX +((nRaggio + cLung) * Cos(-(Angolo + 2) *(pi / 180)))
            y2 = cY +((nRaggio + cLung) * Sin(-(Angolo + 2) *(pi / 180)))
            Call PicStampaTestoRT(x2,y2,n,Angolo)
         End If
         If n = 0 Then Exit For
      Next
      Call DisegnaFigura(aNumeri)
      Call DisegnaDistanze(aCorde)
      ' mostro la figura in output
      Call PicEsegui
   End Sub
   Private Sub DisegnaFigura(aNum)
      Dim k
      For k = 1 To UBound(aNum)
         Call DisegnaCorda(aNum(k),aNum(FuoriX(k + 1,UBound(aNum))),vbRed,True,False)
      Next
   End Sub
   Private Sub DisegnaDistanze(aCorde)
      Dim k
      For k = 1 To UBound(aCorde)
         Call DisegnaCorda(aCorde(k,1),aCorde(k,2),vbBlue,True,True)
      Next
   End Sub
   Private Sub DisegnaCorda(p1,p2,colore,bDisegnaDist,bLineaTratt)
      Dim nX,nY,sDist
      ' p1 e p2 sono i gradi a cui si riferiscono inizio e fine della corda
      'Call PicLineaTratteggiata(aPos(p1,1),aPos(p1,2),aPos(p2,1),aPos(p2,2),colore)
      If AddCorda(p1,p2) Then
         If bLineaTratt Then
            Call PicLineaTratteggiata(aPos(p1,1),aPos(p1,2),aPos(p2,1),aPos(p2,2),colore)
         Else
            Call PicLinea(aPos(p1,1),aPos(p1,2),aPos(p2,1),aPos(p2,2),colore)
         End If
         Call PicPunto(aPos(p1,1),aPos(p1,2),6,colore)
         Call PicPunto(aPos(p2,1),aPos(p2,2),6,colore)
         If bDisegnaDist Then
            If aPos(p1,1) > aPos(p2,1) Then
               nX =(aPos(p1,1) - aPos(p2,1)) / 2 + aPos(p2,1)
            Else
               nX =(aPos(p2,1) - aPos(p1,1)) / 2 + aPos(p1,1)
            End If
            If aPos(p1,2) > aPos(p2,2)Then
               nY =(aPos(p1,2) - aPos(p2,2)) / 2 + aPos(p2,2)
            Else
               nY =(aPos(p2,2) - aPos(p1,2)) / 2 + aPos(p1,2)
            End If
            Call PicCerchio(nX,nY,3,vbBlack,,True,vbYellow)
            nX = nX - 1.5
            nY = nY - 1.5
            sDist = Format2(Distanza(p1,p2))
            Call PicStampaTesto(nX,nY,sDist)
         End If
      End If
   End Sub
   Private Function AddCorda(n1,n2)
      Dim sKey
      If n1 <= n2 Then
         sKey = "k" & Format2(n1) & Format2(n2)
      Else
         sKey = "k" & Format2(n2) & Format2(n1)
      End If
      On Error Resume Next
      CollCorde.Add sKey,sKey
      If Err = 0 Then
         AddCorda = True
      End If
   End Function
End Class
Sub Main
   Dim clsCerchio
   Dim k,v,x,qt
   Dim aCorde
   'v = InputBox("Quale ruota vuoi controllare?",,0)
   'x = InputBox("Quante estrazioni vuoi controllare?",,0)
   'For v = 1 To 10
   ' prendo i numeri dell'ultima estrazione di bari
   ' disegno cerchio ciclometrico , figura dei numeri estratti , diagonali con distanze
   ReDim aNum(0)
   qt = ScegliNumeri(aNum)
   Call OrdinaMatrice(aNum,1)
   qt = UBound(aNum)
   ' le corde sono le distanze interne e sono
   ' considerate tutte le coppie di vertici
   aCorde = SviluppoIntegrale(aNum,2)
   Set clsCerchio = New clsCerchioCiclometrico
   Call clsCerchio.DisegnaCerchioCiclometricoX(aNum,aCorde)
   'Scrivi(DataEstrazione(EstrazioneFin - x)),0,0,1,3,4
   'Scrivi
   'Scrivi NomeRuota(v),0,0,1,3,4
   Scrivi StringaNumeri(aNum)
   ' II° Esempio
   ' dissegno una figura arbitraria
   'Next
End Sub

Alien ecco lo script di questi disegni ne ho tantissimi e ve li regalo alcuni ma chi e bravo
con gli script li puo modificare e fare altri disegni..

 

[i legend]

Vedi l'allegato 2249538

ottimo i legend lo script funziona benissimo e disegna tutte le tabelle solo che devo scrivere la data nella tabella..
e il range degli intervalli delle estr..

Ok, credo che sia uni dei parametri nella funzione grafico. Se non riesci gli do un occhiata. Ti ho evidenziato con il colore rosa le ruote in cui l estratto non è sortito nelle estrazioni desiderate.
Ciao

 

[Zetrix]

ok i legend dopo vedrò se riesco a mettere la data delle estr e i range di interavallo..

 

[Zetrix]

i legend puoi vedere se riesci a sistemare questo script non riesco a disegnare
bene la nazionale e na rompiballe questa nazionale..

 

[i legend]

Non so se riesco , gli darò un occhiata e ti faccio sapere

 

[Alien.]

Vedi l'allegato 2249539

Alien ai provato a inserire nel cerchio i numeretti 4,7,9

?

 

[i legend]

ciao se lancio lo script , mi da errore.
ci sono funzioni che non utilizzo mai , quindi, non saprei cosa modificare.
cosa deve fare?
è uno script modificato ? magari il problema sta nei parametri cambiati.
Ciao

 

[i legend]

Buon natale

 

[Zetrix]

i legend lo cancellato lo script forse non dovevo nemmeno metterlo
non mi interessa la nazionale ma volevo capire perche le linee non collega anche la nazionale..
quello script che ai messo ce lo gia comunque a me lo script non da errore
lo script e stato modificato da me per le mie esigenze di studio ecco perche non dovevo
metterlo lo script adesso hanno copiazzato tutti e non ti dicono nemmeno grazie
non devo mettere piu niente in questo forum..
sono script modificati da me e sono studi miei personali...

 

[nadin]

Ciao Zetrix. E passato anche Natale....

 

[Zetrix]

i legend ecco quale e il problema arriva sulla ruota di venezia e le linee non collegano la nazionale
ecco perche ti ho detto che la nazionale e na rompiballe e non scherzo...
comunque lasciamo stare perche non mi interessa tanto la nazionale..

 

[Zetrix]

ciao nadin e passato anche natale ma non e piu il natale di una volta i tempi sono cambiati..
comunque nadin qua non abbiamo fortuna per l'anno nuovo torno a scrivere nell'altro forum..
adesso vediamo se riusciamo a vincere il super ambo a milano e tutte
comunque ho visto che ce un altro ambo che puo fare e il 59 88 ma dobbiamo aggiornare le ruote
puo darsi che farà a milano..

 

[Zetrix]

?

Alien metti sempre i punti interrogativi che devo dirti di piu..

 

[Zetrix]

nadin ti piace questo disegno..

[CA] [51 .. 46 .. ..] C.1 Ambo 02061 [24/12/2022] [51.08.46.24.54]

 

[i legend]

Vedi messaggio successivo. Ripetuto

 

[i legend]

Purtroppo, a me dava errore e non sono riuscito a capire cosa volevi ottenere. Se vuoi spiegare posso provare a farlo ex novo ma non ti posso garantire che ci riesca.

 

[nadin]

Ciao Zetrix ma di quale altro forum stai dicendo?

 

[Zetrix]

b ------ 2
u ------ 21
o ------ 15
n ------ 14
------------------ 52
s ------ 19
a ------ 1
n ------ 14
t ------ 20
o ------ 15
------------------ 69
s ------ 19
t ------ 20
e ------ 5
f ------ 6
a ------ 1
n ------ 14
o ------ 15
------------------ 80


ciao nadin , i legend , e tutti..

 

[Zetrix]

Purtroppo, a me dava errore e non sono riuscito a capire cosa volevi ottenere. Se vuoi spiegare posso provare a farlo ex novo ma non ti posso garantire che ci riesca.

i legend ho scritto le spiegazioni dello script leggi nel post 512 ho messo anche la tabella..
non so perchè a te dava errore a me lo script non da nessun errore..
che versione di spaziometria ai.. la mia e la versione 1.6.35..
se elimino le linee che collegano i numeri il problema si risolve e evidenzia anche i numeri
sulla nazionale ma vorrei capire perche le linee non collegano anche la nazionale