[Digressions] Shapes your booty, Fractales et consorts...
- Initiateur de la discussion Staple1600
- Date de début
garnote
XLDnaute Junior
Salut @Staple1600 et les autres magiciens!
Il me semble que oui et je l'ai commenté! En tout cas, te sachant virtuose des couleurs et du VBA,
je te confie ce document avant de devenir fou!
. J'ai vu une superbe animation astronomique
et il m'a pris l'idée de la reproduire, pas loin d'y arriver, mais là j'abandonne, je suis exténué!
Le motif que j'obtiens est légèrement différent de celui de YouTube, probablement parce que
je n'ai pas commencé l'animation au même endroit (?), mais j'aimerais bien obtenir
le même effet de couleurs. Et quant à voir tourner les planètes, je n'ai plus la patience
et je m'en fous!
Bonne journée!
N.B. : Vidéo de l'animation retirée! Pourquoi? Mais on peut la retrouver là ;
Il me semble que oui et je l'ai commenté! En tout cas, te sachant virtuose des couleurs et du VBA,
je te confie ce document avant de devenir fou!
. J'ai vu une superbe animation astronomiqueet il m'a pris l'idée de la reproduire, pas loin d'y arriver, mais là j'abandonne, je suis exténué!
Le motif que j'obtiens est légèrement différent de celui de YouTube, probablement parce que
je n'ai pas commencé l'animation au même endroit (?), mais j'aimerais bien obtenir
le même effet de couleurs. Et quant à voir tourner les planètes, je n'ai plus la patience
et je m'en fous!
Bonne journée!
N.B. : Vidéo de l'animation retirée! Pourquoi? Mais on peut la retrouver là ;
Dernière édition:
Staple1600
XLDnaute Barbatruc
Staple1600
XLDnaute Barbatruc
Bonjour le fil, @garnote
Super ton classeur
J'ai voulu creuser la question
Je suis tombé sur ceci (que je qualifierai de mine d'information)
Puis je suis tombé de ma chaise
Pour les couleurs, il faudrait trouver une "équation" liée à la boucle
(ce que je ne suis pas en état de faire malheureusement - lacunes mathématiques irréversibles)
Super ton classeur
J'ai voulu creuser la question
Je suis tombé sur ceci (que je qualifierai de mine d'information)
Puis je suis tombé de ma chaise
Pour les couleurs, il faudrait trouver une "équation" liée à la boucle
(ce que je ne suis pas en état de faire malheureusement - lacunes mathématiques irréversibles)
garnote
XLDnaute Junior
Ave @Staple1600 et tous ceux qui s'intéressent à ces folies.
Bon, comme il me semble qu'il n'est guère facile d'obtenir le motif de l'animation YouTube,
j'ai oublié ces si beaux motifs et j'ai animé l'affaire autrement. Ça me semble plausible.
Bonne journée!
Bon, comme il me semble qu'il n'est guère facile d'obtenir le motif de l'animation YouTube,
j'ai oublié ces si beaux motifs et j'ai animé l'affaire
autrement. Ça me semble plausible.Bonne journée!
Staple1600
XLDnaute Barbatruc
garnote
XLDnaute Junior
Un peu oublié Ulam !
. Trop obsédé par ce truc! Et là il est temps que j'aille me coucher!Quant aux petits verts, pas pour le moment!
Bonne journée!
Staple1600
XLDnaute Barbatruc
Staple1600
XLDnaute Barbatruc
Re
@garnote
Pour une fois, c'est Libre Office qui fait office de lanterne
Maintenant à toi de mobiliser tes neurones pour la suite
(même si je ne suis pas sûr de savoir quelle suite à donner tu as en tête )
@garnote
Pour une fois, c'est Libre Office qui fait office de lanterne
VB:
Sub Test1()
Application.ScreenUpdating = False
Cells.ClearContents
Calc_Spiral "J19", 1, 240, 1, 2, True, True
Columns("A:K").Delete Shift:=xlToLeft
End Sub
Sub Calc_Spiral(strStartingCell$, iStartingNumber%, iMaxCount%, iStep%, iStartingDirection%, bClockwise As Boolean, bSecond As Boolean)
Rem https://ask.libreoffice.org/t/how-to-program-draw-a-square-spiral/29883
Rem <strStartingCell> : A single cell address, e.g. "H12" representing the center of the spiral.
Rem <iStartingNumber> : Integer to be displayed inside the starting cell; Incremented by 1 for each following cell.
Rem <iMaxCount> : The total amount of cells to be drawn in the spiral;
Rem NB. Cells that fall outside of the Sheet''s edges are not counted in the total amount.
Rem <iStep> : Integer increase of the armlength after each turn in the spiral.
Rem <iStartingDirection> : Determines the direction of the second cell to be drawn, relative to the starting cell.
Rem 0=RIGHT ; 1=UP ; 2=LEFT ; 3=DOWN.
Rem <bClockwise> : Boolean indicating whether the spiral goes clockwise ( <True> ) or counter-clockwise ( <False> ).
Rem <bSecond> : If <True> , the armlength increases only every second turn instead of every turn.
Rem Example call : Calc_Spiral( "H12", 1, 100, 1, 2, True, True )
'On Error Resume Next
Dim oSheet As Worksheet, oCell As Range, iColumn%, iRow%, m%, iCount%, iDirection%, iCurrentStep%, iCurrentPos%, iArmCount%
Set oSheet = ActiveSheet
Set oCell = oSheet.Range(strStartingCell)
iRow = oCell.Row
iColumn = oCell.Column
iCount = 0
iDirection = iStartingDirection
iCurrentStep = iStep
iCurrentPos = 0
' If iCurrentStep = 0 Then iCurrentStep = 1 '
m = 1
If bClockwise Then m = 3
Do While iCount < iMaxCount
oCell.Value = iStartingNumber + iCount 'REM Display the index number inside the cell.
If iCurrentPos = iCurrentStep Then 'Rem End of Arm reached:
iArmCount = iArmCount + 1
iDirection = (iDirection + m) Mod 4 'REM Compute the Next direction.
iCurrentPos = 0
If Not bSecond Or (iCount > 0 And iArmCount Mod 2 = 0) Then iCurrentStep = iCurrentStep + iStep
End If
Select Case iDirection
Case 0 'REM Right
iColumn = iColumn + 1
Case 1 'REM Up
iRow = iRow - 1
Case 2 'REM Left
iColumn = iColumn - 1
Case 3 'REM Down
iRow = iRow + 1
End Select
Set oCell = Cells(iColumn, iRow) 'REM Go towards the Next Cell.
iCurrentPos = iCurrentPos + 1
iCount = iCount + 1
Loop
End Sub(même si je ne suis pas sûr de savoir quelle suite à donner tu as en tête
)
Staple1600
XLDnaute Barbatruc
Re
Si le coeur vous en dit , un petit quizz
NB: Tout plein d'indice à glaner dans la discussion.
Indice 1
(a) puer pædagoganius
(b) la somme des carrés des cinq premiers nombres premiers
Indice 1 = a+b
Oui, je sais, c'est tiré par les cheveux
Si le coeur vous en dit , un petit quizz
Indice 1
(a) puer pædagoganius
(b) la somme des carrés des cinq premiers nombres premiers
Indice 1 = a+b
Oui, je sais, c'est tiré par les cheveux
Dernière édition:
Staple1600
XLDnaute Barbatruc
Bonjour @garnote , le fil
En ce week-end prolongé, j'a trouvé un bout de code sur le net pour ta spirale évoquée dans le message#208
Et une formule pour "marquer" les nombres premiers en MFC
En ce week-end prolongé, j'a trouvé un bout de code sur le net pour ta spirale évoquée dans le message#208
VB:
Sub Spirale_AntiHoraire()
'crédits: Kirszu
x = 0
y = 0
d = -1 ' 1 = sens horaire
m = 1
i = 1
j = 1
Do While i < 101
Do While 2 * x * d < m
Cells(x + 100, y + 100).Value = j
x = x + d
j = j + 1
Loop
Do While 2 * y * d < m
Cells(x + 100, y + 100).Value = j
y = y + d
j = j + 1
Loop
d = -1 * d
m = m + 1
i = i + 1
Loop
'ma modeste contribution ;-)
Range("$AY$51:$ET$151").Cut Range("A1")
End Sub
=OU(A1=2;A1=3;ESTNA(EQUIV(VRAI;A1/LIGNE(INDIRECT("2:"&ENT(RACINE(A1))))=ENT(A1/LIGNE(INDIRECT("2:"&ENT(RACINE(A1)))));0)))
garnote
XLDnaute Junior
Wow! Magique! Merci!
Staple1600
XLDnaute Barbatruc
Bonjour le fil
Comme c'est la rentrée, j'ai ressorti mes crayons de couleurs.
Mais plutôt que de colorier du papier, je colorie des cellules Excel
NB: Une fois la MFC, mise en place, on peut ne pas la relancer à chaque nouvelle exécution
(en mettant en commentaire la ligne Call mCouleurs dans la macro mGrille)
PS: Pour avoir d'autres jolies dessins, amusez à varier les calculs
En modifiant la ligne t(x,y) =...
Exemple : t(x, y) = Sin((3 * v_PHI * (x Or y)) / 2)
N'hésiter pas à poster des exemples de calculs qui donnent de jolis motifs.
Bon amusement coloré
Comme c'est la rentrée, j'ai ressorti mes crayons de couleurs.
Mais plutôt que de colorier du papier, je colorie des cellules Excel
VB:
Sub OCEBO()
mGRILLE
mPAVAGE
End Sub
Private Sub mGRILLE()
Application.ScreenUpdating = False
With Range("A1:IV256")
.RowHeight = 4
.ColumnWidth = 0.4
End With
Call mCouleurs
End Sub
Private Sub mPAVAGE()
Dim t(1 To 256, 1 To 256), v_PI, v_PHI, x%, y%
v_PI = 4 * Atn(1)
v_PHI = (1 + Sqr(5)) / 2
Application.ScreenUpdating = False
For x = 1 To 256
For y = 1 To 256
t(x, y) = _
Cos((x Xor y) * v_PI * v_PHI / 23) Xor Sin(Sqr(v_PHI))
Next
Next
Cells(1).Resize(UBound(t, 1), UBound(t, 2)).Value = t
End Sub
Private Sub mCouleurs()
Dim mfc
mfc = Array(Array(1, 8109667), Array(5, 8711167), Array(2, 7039480))
With Range("A1:IV256")
.FormatConditions.AddColorScale ColorScaleType:=3
.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
.FormatConditions(1).ColorScaleCriteria(2).Value = 50
For k = 0 To 2
.FormatConditions(1).ColorScaleCriteria(k + 1).Type = mfc(k)(0)
.FormatConditions(1).ColorScaleCriteria(k + 1).FormatColor.Color = mfc(k)(1)
Next
End With
End Sub(en mettant en commentaire la ligne Call mCouleurs dans la macro mGrille)
PS: Pour avoir d'autres jolies dessins, amusez à varier les calculs
En modifiant la ligne t(x,y) =...
Exemple : t(x, y) = Sin((3 * v_PHI * (x Or y)) / 2)
N'hésiter pas à poster des exemples de calculs qui donnent de jolis motifs.
Bon amusement coloré
