Figure utente esempi utilizzo.

i legend · 9 Ottobre 2015

Ciao ho disegnato una figura e l ho salvata .dat
Ora vorrei utilizzarla in spazio script
gli esempi che ci sono non funzionano.
In pratica vorrei che lo script restituisca. le figure trovate i vertici data inizio e data Fine .la figura èirregolare non parallelepipedo.le funzioni già esistono ma non lè so utilizzare.
Ciao e grazie
A chiunque possa aiutarmi

LuigiB · 9 Ottobre 2015

ciao legend questo esempio funziona

Codice:

Sub Main
    Dim idEstr
    Dim CollP
    Dim PPL ' As clsParallelepipedo
    Dim CRD ' As clsVertice
    
    ReDim aRuote(1)
    ReDim aPoste(10)
    Dim sFileFigura
    
    aRuote(1) = 11
    aPoste(2) = 1
    
    sFileFigura = GetDirectoryAppData  &  "Strutture\Varie\test_consecutiviUnodoppioDellaltro.dat"
    
    
    
    For idEstr =8500 To EstrazioniArchivio - 10
        ' ottengo i parallelepipedi presenti nell'estrazione
        Call GetCollFiguraUtente(idEstr,sFileFigura,CollP)
    
        ' per ogni parallelepipedo trovato nella tale estrazione faccio il disegno
        For Each PPL In CollP
            
            ReDim aNumeri(8)
            
            
            
                ReDim aNumeri(0)
                Call GetArrayNumeriFromFiguraSpaziometrica(PPL,aNumeri)
                
                Call DisegnaFiguraSpaziometrica(idEstr,PPL)
                Call ImpostaGiocata(1,aNumeri,aRuote,aPoste,10,2)
                Call Gioca(idEstr)
                
            
        Next
    
        
    Next
    Call ScriviResoconto
End Sub

i legend · 9 Ottobre 2015

Ok adesso funziona
Era uno degli script che avevo tè stato.
Per rendere più agevole la ricerca
Ho utilizzato la tua mitica
ScegliFile (GetDirectoryAppData,".dat")
Questo così non sbaglio a selezionare.
Domanda
Funziona solo su un concorso?
Non fa le ricerche come il modulo Edit strutture in più estrazioni?
Sarebbe chiedere l impossibile vero?
Ci vorrebbe troppo tempo per le ricerche.
Domanda due
Ci fermiamo a -10 per poter utilizzare il gioca?
Grazie mille come sempre

Notte

LuigiB · 10 Ottobre 2015

probabilmente non ti funzionava proprio perche il percorso era sbagliato
quello che dici gia si puo fare anche se in un modo un po' diverso , è chiaro che
la velocita ne soffre quindi fai un range di analisi contenuto

Codice:

Option Explicit
Sub Main
    Dim sFile
    Dim collFig
    Dim CollPar
    Dim clsFig
    Dim nFatte
    Dim sFilefigura
    Dim nRigheMax,nColonneMax
    Dim Inizio
    Dim nRidondanzaEstr
    
    sFilefigura = GetDirectoryAppData & "Strutture\varie\cubo3test.dat"
    nRigheMax = 30
    nColonneMax = 55
    nRidondanzaEstr = 10 ' in ogni quadro mostra le ultime 10 del quadro precedete
    For Inizio = EstrazioneIni To EstrazioneFin Step 50
        ReDim aQuadro(nRigheMax,nColonneMax)
        Call AlimentaQuadroNumeri(aQuadro,Inizio,nRidondanzaEstr)
        'Call ScriviQuadro(aQuadro)
        Call GetCollFiguraUtenteQN(aQuadro,sFilefigura,collFig)
        'Call GetCollParallelepipediQN(aQuadro,CollPar)
        For Each clsFig In collFig
            Call DisegnaFiguraSpaziometricaQN(aQuadro,clsFig)
            If ScriptInterrotto Then Exit For

            DoEventsEx
            
        Next
        
        If ScriptInterrotto Then Exit For
        
    Next
    

End Sub
Sub ScriviQuadro(aQuadro)
    Dim k
    Dim s
    For k = 1 To UBound(aQuadro)
        s = ""
        For e = 1 To UBound(aQuadro,2)
            s = s & Format2(aQuadro(k,e)) & " "
        Next
        Call Scrivi(s)
    Next
End Sub
Sub AlimentaQuadroNumeri(aQuadro,Inizio,nRidondanzaEstr)
    Dim k,e,r,riga
    Dim nStart, nEnd,Col
    nStart = Inizio - nRidondanzaEstr
    If nStart <= 0 Then nStart = Inizio
    nEnd = nStart + (UBound(aQuadro) -1)
    For k = nStart To nEnd
        riga = riga + 1
        Col = 0
        For r = 1 To 12
            If r <> 11 Then
                For e = 1 To 5
                    Col = Col + 1
                    aQuadro(riga,Col) = Estratto(k,r,e)
                Next
            End If
        Next
    Next
End Sub

i legend · 10 Ottobre 2015

Buona giornata; )
Apro lottoced e vedo questo programma

Luigi oggi non è il mio compleanno ,ma vedo che ti sei preso avanti

Grazie mille.
Ricoperto riga per riga .
Ti ho mai detto che sei grande?
Grazie mille. Ora sono fuori nel pomeriggio faccio le prove.
Grazzzzzziiiiiiiiiiiiiiieeeeeeeeerr

i legend · 10 Ottobre 2015

Funziona

Ovviamente non avevo dubbi.
Grazie mille
Se riesco faccio una sorpresa a tutti altrimenti ci sbatto la testa.
Ciao; )
Grazie davvero è uno script fantastico

i legend · 10 Ottobre 2015

Luigi per me non è importante disegnare le figure quanto trovare la data in cui si trova il primo vertice la data inizio struttura . Ci sbatto un po la testa altridente ti chiederò qualche indizio.
Ciao e grazie

LuigiB · 11 Ottobre 2015

Ciao , vedi se funziona , la logica comunque è questa

Option Explicit

Codice:

Option Explicit
Sub Main
    Dim sFile
    Dim collFig
    Dim CollPar
    Dim clsFig
    Dim nFatte
    Dim sFilefigura
    Dim nRigheMax,nColonneMax
    Dim Inizio
    Dim nRidondanzaEstr
    Dim bDisegnaFig
    Dim nInizioReale
    
    bDisegnaFig = True
    
    
    sFilefigura = GetDirectoryAppData & "Strutture\varie\cubo3test.dat"
    nRigheMax = 30
    nColonneMax = 55
    nRidondanzaEstr = 10 ' in ogni quadro mostra le ultime 10 del quadro precedete
    For Inizio = EstrazioneIni To EstrazioneFin Step 50
        ReDim aQuadro(nRigheMax,nColonneMax)
        Call AlimentaQuadroNumeri(aQuadro,Inizio,nRidondanzaEstr ,nInizioReale)
        'Call ScriviQuadro(aQuadro)
        Call GetCollFiguraUtenteQN(aQuadro,sFilefigura,collFig)
        'Call GetCollParallelepipediQN(aQuadro,CollPar)
        For Each clsFig In collFig
            If bDisegnaFig Then
                Call DisegnaFiguraSpaziometricaQN(aQuadro,clsFig)
            End If
            Call ScriviInfoFigTrov(clsFig,nInizioReale)
            
            Call Scrivi
            Call Scrivi(String(50,"="))
            Call Scrivi
            
            If ScriptInterrotto Then Exit For
            DoEventsEx
        Next
        If ScriptInterrotto Then Exit For
    Next
End Sub
Sub ScriviQuadro(aQuadro)
    Dim k
    Dim s
    For k = 1 To UBound(aQuadro)
        s = ""
        For e = 1 To UBound(aQuadro,2)
            s = s & Format2(aQuadro(k,e)) & " "
        Next
        Call Scrivi(s)
    Next
End Sub
Sub AlimentaQuadroNumeri(aQuadro,Inizio,nRidondanzaEstr ,nRetStart )
    Dim k,e,r,riga
    Dim nStart,nEnd,Col
    nStart = Inizio - nRidondanzaEstr
    If nStart <= 0 Then nStart = Inizio
    nRetStart = nStart
    
    nEnd = nStart +(UBound(aQuadro) - 1)
    For k = nStart To nEnd
        riga = riga + 1
        Col = 0
        For r = 1 To 12
            If r <> 11 Then
                For e = 1 To 5
                    Col = Col + 1
                    aQuadro(riga,Col) = Estratto(k,r,e)
                Next
            End If
        Next
    Next
End Sub
Sub ScriviInfoFigTrov(clsFig,Inizio)
    Dim clsV ' clsVertice
    Dim i,j,jj
    Dim nPrimaRiga,nUltimaRiga

    Dim nidEstrI,nidEstrF,nRuota
    
    ReDim aIdRighe(clsFig.CollCoord.count - 1)
    ReDim aRuoteInt(clsFig.CollCoord.Count)
    ReDim aNumeri(clsFig.CollCoord.Count)
    ReDim aChiusure(clsFig.CollCoord.Count)
    
    For Each clsV In clsFig.CollCoord
        
        aIdRighe(i) = clsV.Riga
        
        i = i + 1
        nRuota = GetRuotaFromColonna(clsV.Colonna)
        aRuoteInt(i) = nRuota
        
        If clsV.bChiusura = False Then
            j = j + 1
            aNumeri(j) = clsV.Numero
        Else
            jj = jj + 1
            
            aChiusure(jj) = clsV.Numero
            

        End If
        
    Next
    
    nPrimaRiga = MinimoV(aIdRighe)
    nUltimaRiga = MassimoV(aIdRighe)


    
    nidEstrI =Inizio + (nPrimaRiga-1)
    nidEstrF =Inizio  + (nUltimaRiga-1)
    
    Call EliminaRipetuti(aRuoteInt,True)
    Call EliminaRipetuti(aNumeri,True)
    Call EliminaRipetuti(aChiusure,True)
    

    
    Call Scrivi("Inizio struttura  : " & GetInfoEstrazione(nidEstrI))
    Call Scrivi("Fine struttura    : " & GetInfoEstrazione(nidEstrF))
    Call Scrivi("Ruote interessate : " & StringaRuote(aRuoteInt))
    Call Scrivi("Numeri            : " & StringaNumeri(aNumeri))
    Call Scrivi("Chiusure          : " & StringaNumeri(aChiusure))
    
    
    
End Sub
Function GetRuotaFromColonna(C)
    
    Dim r
    
    If C Mod 5 = 0 Then
        r = C /5
    Else
        If C > 5 Then
            r =(C\5) + 1
        Else
            r = 1
        End If
    End If
    
    If r = 11 Then r = 12
    GetRuotaFromColonna = r
        
End Function

i legend · 11 Ottobre 2015

Provo anche questa meraviglia. Al momento sono via ma non vedo l ora di rientrare per provarlo.
Ciao e grazie mille.
Sto cercando imparare dal migliore; )
Buona domenica e buon pranzo.

LuigiB · 11 Ottobre 2015

nello script che avevo postato c'era un problema , la logica era corretta ma era sbagliata l'individuazione delle date e riportava i numeri doppi.
Fatte le dovute correzioni lo script l'ho modificato percio ricopialo daccapo vedi come funziona e poi dedicati a quello che volevi fare
ciao

i legend · 11 Ottobre 2015

Ciao luigi grazie
Devo ancora rientrare.
Almeno mi divertissi
Appena riesco ti ragguaglio

Grazie mille

LuigiB · 11 Ottobre 2015

ciao Legend , usa questo ultimo script che posto qui.
La differenza è che in questa nuova versione la struttura viene disegnata tramite codice in script

Codice:

Option Explicit
Sub Main
    Dim sFile
    Dim collFig
    Dim CollPar
    Dim clsFig
    Dim nFatte
    Dim sFilefigura
    Dim nRigheMax,nColonneMax
    Dim Inizio
    Dim nRidondanzaEstr
    Dim bDisegnaFig
    Dim nInizioReale
    Dim nStart,nEnd
    
    bDisegnaFig = True
    
    nStart = EstrazioneIni
    nEnd = EstrazioneFin
    
    
    sFilefigura = GetDirectoryAppData & "Strutture\varie\cubo3test.dat"
    nRigheMax = 30
    nColonneMax = 55
    nRidondanzaEstr = 10 ' in ogni quadro mostra le ultime 10 del quadro precedete
    For Inizio = nStart To nEnd Step nRigheMax
        ReDim aQuadro(nRigheMax,nColonneMax)
        Call AlimentaQuadroNumeri(aQuadro,Inizio,nRidondanzaEstr,nInizioReale)
        'Call ScriviQuadro(aQuadro)
        Call GetCollFiguraUtenteQN(aQuadro,sFilefigura,collFig)
        'Call GetCollParallelepipediQN(aQuadro,CollPar)
        For Each clsFig In collFig
            'If bDisegnaFig Then
            'Call DisegnaFiguraSpaziometricaQN(aQuadro,clsFig)
            'End If
            Call ScriviInfoFigTrov(clsFig,nInizioReale,bDisegnaFig)
            Call Scrivi
            Call Scrivi(String(50,"="))
            Call Scrivi
            If ScriptInterrotto Then Exit For
            DoEventsEx
        Next
        If ScriptInterrotto Then Exit For
        Call AvanzamentoElab(nStart,nEnd,Inizio)
    Next
End Sub
Sub ScriviQuadro(aQuadro)
    Dim k
    Dim s
    For k = 1 To UBound(aQuadro)
        s = ""
        For e = 1 To UBound(aQuadro,2)
            s = s & Format2(aQuadro(k,e)) & " "
        Next
        Call Scrivi(s)
    Next
End Sub
Sub AlimentaQuadroNumeri(aQuadro,Inizio,nRidondanzaEstr,nRetStart)
    Dim k,e,r,riga
    Dim nStart,nEnd,Col
    nStart = Inizio - nRidondanzaEstr
    If nStart <= 0 Then nStart = Inizio
    nRetStart = nStart
    nEnd = nStart +(UBound(aQuadro) - 1)
    For k = nStart To nEnd
        riga = riga + 1
        Col = 0
        For r = 1 To 12
            If r <> 11 Then
                For e = 1 To 5
                    Col = Col + 1
                    aQuadro(riga,Col) = Estratto(k,r,e)
                Next
            End If
        Next
    Next
End Sub
Sub ScriviInfoFigTrov(clsFig,Inizio,bDisegna)
    Dim clsV ' clsVertice
    Dim i,j,jj
    Dim nPrimaRiga,nUltimaRiga
    Dim nidEstrI,nidEstrF,nRuota
    ReDim aIdRighe(clsFig.CollCoord.count - 1)
    ReDim aRuoteInt(clsFig.CollCoord.Count)
    ReDim aNumeri(clsFig.CollCoord.Count)
    ReDim aChiusure(clsFig.CollCoord.Count)
    For Each clsV In clsFig.CollCoord
        aIdRighe(i) = clsV.Riga
        i = i + 1
        nRuota = GetRuotaFromColonna(clsV.Colonna)
        aRuoteInt(i) = nRuota
        If clsV.bChiusura = False Then
            j = j + 1
            aNumeri(j) = clsV.Numero
        Else
            jj = jj + 1
            aChiusure(jj) = clsV.Numero
        End If
    Next
    nPrimaRiga = MinimoV(aIdRighe)
    nUltimaRiga = MassimoV(aIdRighe)
    nidEstrI = Inizio +(nPrimaRiga - 1)
    nidEstrF = Inizio +(nUltimaRiga - 1)
    Call EliminaRipetuti(aRuoteInt,True)
    Call EliminaRipetuti(aNumeri,True)
    Call EliminaRipetuti(aChiusure,True)
    If bDisegna Then
        Call OrdinaMatrice(aRuoteInt,1)
        Call DisegnaStruttura(clsFig,aRuoteInt,nidEstrI,nidEstrF,Inizio)
    End If
    Call Scrivi("Inizio struttura  : " & GetInfoEstrazione(nidEstrI))
    Call Scrivi("Fine struttura    : " & GetInfoEstrazione(nidEstrF))
    Call Scrivi("Ruote interessate : " & StringaRuote(aRuoteInt))
    Call Scrivi("Numeri            : " & StringaNumeri(aNumeri))
    Call Scrivi("Chiusure          : " & StringaNumeri(aChiusure))
End Sub
Function GetRuotaFromColonna(C)
    Dim r
    If C Mod 5 = 0 Then
        r = C /5
    Else
        If C > 5 Then
            r =(C\5) + 1
        Else
            r = 1
        End If
    End If
    If r = 11 Then r = 12
    GetRuotaFromColonna = r
End Function
Sub DisegnaStruttura(clsFig,aRuote,nIdEstrIni,nIdEstrFin,nIdEstrBase)
    Dim nWPic ' larghezza oggetto pic
    Dim nHPic ' Altezza oggetto pic
    Dim nHCella ' altezza cella in mm
    Dim nWCella ' larghezza cella
    Dim nBordo ' bordo esterno all'immagine
    Dim nWDataEstr ' larghezza colonna data
    Dim nRuoteTot ' totale ruote interessate
    Dim nRighe ' quantita estrazioni interessate dalla struttura
    Dim nSpess
    Dim clsV
    Dim nX,nY,nXX,nYY
    Dim k,r,e,N,NTipo
    nBordo = 5
    nHCella = 7
    nWCella = 7
    nWDataEstr = 50
    nRuoteTot = UBound(aRuote)
    nRighe = nIdEstrFin -(nIdEstrIni - 1)
    Scrivi nRighe & "_" & nRuoteTot
    nWPic = nWDataEstr +(nRuoteTot *(nWCella*5))
    nHPic = nHCella +(nHCella * nRighe) ' la riga del titolo + le n righe
    nWPic = nWPic +(nBordo * 2)
    nHPic = nHPic +(nBordo * 2)
    PicClear
    Call PicSetDimensioni(nWPic,nHPic,nWPic,nHPic)
    ' Quadrato bordo esterno
    nSpess = 2
    nX = nBordo : nY = nBordo : nXX = nWPic - nBordo : nYY = nBordo
    Call PicLinea(nX,nY,nXX,nYY,,nSpess)
    nX = nWPic - nBordo : nY = nBordo : nXX = nX : nYY = nHPic - nBordo
    Call PicLinea(nX,nY,nXX,nYY,,nSpess)
    nX = nBordo : nY = nHPic - nBordo : nXX = nWPic - nBordo : nYY = nHPic - nBordo
    Call PicLinea(nX,nY,nXX,nYY,,nSpess)
    nX = nBordo : nY = nBordo : nXX = nX : nYY = nHPic - nBordo
    Call PicLinea(nX,nY,nXX,nYY,,nSpess)
    ' righe orizzontali
    nSpess = 1
    nX = nBordo
    nY = nBordo + nHCella
    nXX = nWPic - nBordo
    For k = 1 To nRighe
        If k = 1 Then
            nSpess = 2
        Else
            nSpess = 1
        End If
        nYY = nY
        Call PicLinea(nX,nY,nXX,nYY,,nSpess)
        nY = nY + nHCella
    Next
    ' righe verticali
    nSpess = 1
    nY = nBordo
    nYY = nHPic - nBordo
    nX = nWDataEstr + nBordo
    For k = 1 To nRuoteTot * 5
        nXX = nX
        If(k - 1) Mod 5 = 0 Then
            nY = nBordo
        Else
            nY = nBordo + nHCella
        End If
        Call PicLinea(nX,nY,nXX,nYY,,nSpess)
        nX = nX + nWCella
    Next
    ' intestazione tabella
    nY = nBordo + 1
    nX = nBordo + 2
    Call PicStampaTesto(nX,nY,"Data",,,,,10)
    ' nomi ruote
    nY = nBordo + 1
    For k = 1 To nRuoteTot
        nX = nBordo + nWDataEstr +((k - 1) *(nWCella *5)) + 2
        Call PicStampaTesto(nX,nY,NomeRuota(aRuote(k)),,,,,10)
    Next
    ' righe dati
    nY = nBordo + nHCella + 1
    For k = nIdEstrIni To nIdEstrFin
        nX = nBordo + 2
        Call PicStampaTesto(nX,nY,GetInfoEstrazione(k),,,,,8)
        nX = nBordo + nWDataEstr + 2
        For r = 1 To UBound(aRuote)
            For e = 1 To 5
                N = Estratto(k,aRuote(r),e)
                NTipo = 0
                For Each clsV In clsFig.CollCoord
                    If clsv.Numero = N Then
                        If clsv.riga +(nIdEstrBase - 1) = k Then
                            If GetRuotaFromColonna(clsV.colonna) = aRuote(r) Then
                                If clsv.bChiusura Then
                                    NTipo = 1
                                Else
                                    NTipo = 2
                                End If
                            End If
                        End If
                    End If
                Next
                If NTipo = 0 Then
                    Call PicStampaTesto(nX,nY,Format2(N),,,,,8)
                ElseIf NTipo = 1 Then
                    Call PicRiempi(nX,nY,vbGreen)
                    Call PicStampaTesto(nX,nY,Format2(N),,True,,,8,vbRed)
                ElseIf NTipo = 2 Then
                    Call PicRiempi(nX,nY,vbYellow)
                    Call PicStampaTesto(nX,nY,Format2(N),,True,,,8,vbBlue)
                End If
                nX = nX + nWCella
            Next
        Next
        nY = nY + nHCella
    Next
    Call PicEsegui
End Sub

i legend · 11 Ottobre 2015

Sono appena tornato. Tempo di una cena frugale
E ricopio lo script.
Ps :
Ti sembrerà stupido ma l ho letto almeno 6 volte.
E come quando a natale ricevi il regali che volevi ma non te la senti di chiedere.
Huaooo! !!!!!!!
Nessuno ha mai messo in rete codice di questo livello.
Prima erano pochissimi a fare script.
Da quando ci sei te sicuramente siamo moltissimi di più.
Mi spiace che siano così pochi a dirti grazie.
Per quello che vale
Tu dico grazie a nome di quei molti che non lo fanno.
Ora basta se no ti monti la testa.
Ps:
Se mai dovessi candidarti ti voto

P.p.s
Per il tuo bene non farlo

Ciao

i legend · 11 Ottobre 2015

Finito di ricopiare o riga x riga è un capolavoro.
Grazie

Appena lanciato.
Ti tengo aggiornato sul lavoro che intendo fare,
Ciao; )

i legend · 11 Ottobre 2015

La tabella piccola sembra non funzionare correttamente con i colori ma probabilmente ho sbagliato io nel ricopiare qualcosa.
Domani controllo tutto

Grazie mille

Ciao

LuigiB · 11 Ottobre 2015

ciao legend .. non so dalle prove che ho fatto i colori li mette bene .. al limite posta un immagine per farmi capire cosa fa a te.

i legend · 11 Ottobre 2015

Luigi se faccio tethering Se ho virus nel pc lo passo al cell?
Altrimenti non so come postare le immagini

A domani.
Ciao

LuigiB · 11 Ottobre 2015

a me viene cosi

hostare immagini

i legend · 11 Ottobre 2015

Non si chiude la riga della tabella della seconda ruota e il colore si distribuisce tutto attorno.
Comunque devo controllare
Dove ho sbagliato a ricopiare.
Lo faccio domani con calma

Ciao

P.s
Alzi l astice la della conoscenza.
Sio costretti a postare script sempre migliori.
Se continuo così forse fra 15 anni arrivo ai livelli attuali di Joe. O almeno è quello che spero; )
Ciao

i legend · 12 Ottobre 2015

Ciao luigi ovviamente come pensavo avevo sbagliato a ricopiare il codice;
Cmq il fatto che ho capito dove andare a cercare gli errori vuol dire che ho capito lo script.
Grazie semplicemente perfetto.
Ammiro la tua capacita logica.
Lo ripeto
Lost in ammiration

Sei un mito

Figure utente esempi utilizzo.

Premium Member

LuigiB

Guest

Premium Member

LuigiB

Guest

Premium Member

Premium Member

Premium Member

LuigiB

Guest

Premium Member

LuigiB

Guest

Premium Member

LuigiB

Guest

Premium Member

Premium Member

Premium Member

LuigiB

Guest

Premium Member

LuigiB

Guest

Premium Member

Premium Member