[Digressions] Shapes your booty, Fractales et consorts...

Dranreb · 9 Octobre 2022

Tu veux dire que la description de la teinte ne correspond pas à celle du pixel sélectionné dans l'image ?
Chez moi ça marche correctement. Juste pour l'affichage, seule la teinte de la couleur du LabInfo est conforme à cette description, à moins d'un clic droit ou si la touche Ctrl est enfoncée.

Staple1600 · 9 Octobre 2022

Re

@Dranreb
Voir cet exemple
(ici ma souris est sur Bleu sur Image1)

Dranreb · 9 Octobre 2022

Pas toute la couleur non, seule sa composante A, la teinte, est conforme. Je ne changerai pas ça, car ça enlèverait une partie de la signalisation d'utilisation de la touche Ctrl ou d'un clic droit, visant à reproduire aussi toute les caractéristiques dans la couleur à changer.
Au fait, c'était peut être une erreur d'afficher le 3 UserForm car E ne dépend que d'un seul des 3, seul H et J nécessitent les 2 autres en même temps. Puis-je modifier pour n'afficher soit que E soit A et F ou tu est déjà trop habitué aux 3 ?

Staple1600 · 9 Octobre 2022

@Dranreb
Ce n'était pas une critique

Je pensais que j'avais un problème d'écran. C'est tout.

C'est votre travail. Vous pouvez modifier ce que vous estimez devoir modifier.

Pour moi, c'est déjà un classeur magistral en l'état.

garnote · 10 Octobre 2022

Salutations à @Staple1600 @Dranreb @TooFatBoy et compagnie,
Bravo pour vos belles fractales! Et je me permets d'ajouter
une nouvelle folie dans la catégorie "et consorts..."

Staple1600 · 10 Octobre 2022

Bonjour le fil, @garnote, @Dranreb

J'ai joué,

cogité,

déplacer les shapes à la mano

...puis j'ai craqué

VB:

Sub Solution()
Dim i
For i = 1 To 14
Application.Run CStr("Poly" & i)
Next
End Sub

Staple1600 · 10 Octobre 2022

Re

Puisqu'on parle folie et consorts
Alors une petite gaminerie

VB:

Sub SolutionEtGribouillage()
Dim i
RAZ
For i = 1 To 14
Application.Run CStr("Poly" & i)
Next
ollyWood
End Sub
Sub RAZ()
Dim s As Shape
For Each s In ActiveSheet.Shapes
If s.Type = 5 Then
s.Delete
End If
Next
End Sub
Sub ollyWood()
Dim s As Shape
Randomize 1600
ps = Array(-2, 17, 20, 11, 2, 21, 3, 7, 12, 9, 24, 13, 23, 6, 1, 15, 18, 19, 14, 8, 16, 22, 5, 10, 4)(Application.RandBetween(1, 24))
For Each s In ActiveSheet.Shapes
If s.Type = 5 Then
conscient s, ps
End If
Next
End Sub
Sub conscient(s As Shape, x)
s.ShapeStyle = 67
With s.Glow
    .Color.ObjectThemeColor = 9: .Color.TintAndShade = 0: .Color.Brightness = 0
    .Transparency = 0.6000000238: .Radius = 8
    End With
    s.SoftEdge.Type = 3: s.ThreeD.BevelTopType = 3: s.ThreeD.BevelTopInset = 6: s.ThreeD.BevelTopDepth = 6
    With s.Fill
    .Visible = -1: .PresetTextured x: .TextureTile = -1
    .TextureOffsetX = 0: .TextureOffsetY = 0
    .TextureHorizontalScale = 1: .TextureVerticalScale = 1: .TextureAlignment = 0
End With
End Sub

garnote · 11 Octobre 2022

Staple1600 à dit:

Re

Puisqu'on parle folie et consorts
Alors une petite gaminerie

VB:

Sub SolutionEtGribouillage()
Dim i
RAZ
For i = 1 To 14
Application.Run CStr("Poly" & i)
Next
ollyWood
End Sub
Sub RAZ()
Dim s As Shape
For Each s In ActiveSheet.Shapes
If s.Type = 5 Then
s.Delete
End If
Next
End Sub
Sub ollyWood()
Dim s As Shape
Randomize 1600
ps = Array(-2, 17, 20, 11, 2, 21, 3, 7, 12, 9, 24, 13, 23, 6, 1, 15, 18, 19, 14, 8, 16, 22, 5, 10, 4)(Application.RandBetween(1, 24))
For Each s In ActiveSheet.Shapes
If s.Type = 5 Then
conscient s, ps
End If
Next
End Sub
Sub conscient(s As Shape, x)
s.ShapeStyle = 67
With s.Glow
    .Color.ObjectThemeColor = 9: .Color.TintAndShade = 0: .Color.Brightness = 0
    .Transparency = 0.6000000238: .Radius = 8
    End With
    s.SoftEdge.Type = 3: s.ThreeD.BevelTopType = 3: s.ThreeD.BevelTopInset = 6: s.ThreeD.BevelTopDepth = 6
    With s.Fill
    .Visible = -1: .PresetTextured x: .TextureTile = -1
    .TextureOffsetX = 0: .TextureOffsetY = 0
    .TextureHorizontalScale = 1: .TextureVerticalScale = 1: .TextureAlignment = 0
End With
End Sub

Wow! Quel chic! Te reste à faire la même chose pour les 455 autres solutions!

garnote · 11 Octobre 2022

Bonsoir à tous,
Toujours dans "et consorts"
Ayant vu un "dessin" dans un livre avec comme explication : Une cardioïde peut-être obtenue comme l'enveloppe d'un segment joignant deux points d'un cercle, le premier tournant deux fois plus vite que le second. (Création de Jos Leys). Suite à de nombreuses réflexions et recherches, j'ai fini par comprendre la maudite phrase et j'ai presque obtenu la même chose que Jos avec ctrl + maj + J.
Et ce site de Jos Leys vaut vraiment le détour pour les amateurs de fractales et autres folies!

Galleries (josleys.com)

Bonsoir, Bonne nuit !

Staple1600 · 11 Octobre 2022

Bonsoir @garnote

Cool

J'ai appris un truc que j'ignorais sur Shapes.Addline

Et merci pour le lien

PS: Tu as vu mon MP?

garnote · 11 Octobre 2022

Staple1600 à dit:
Bonsoir @garnote

Cool

J'ai appris un truc que j'ignorais sur Shapes.Addline

Et merci pour le lien

PS: Tu as vu mon MP?

Ave @Staple1600
Hein! Je t'ai appris quelque chose? . Et dans mon fichier : rotaions ---> rotations!
Et MP, c'est quoi ça?

Staple1600 · 12 Octobre 2022

Re

Oui, j'ignorais ceci

VB:

Sub test_A()
Set shp = ActiveSheet.Shapes.AddLine(50, 100, 50, 200).Line
Dim sh_p As Shape
Set sh_p = ActiveSheet.Shapes.AddLine(75, 100, 75, 200)
End Sub
Sub test_B_Pas_OK()
Dim shp As Shape
Set shp = ActiveSheet.Shapes.AddLine(50, 50, 50, 50).Line
End Sub

Quel le petit plus du .Line ?

MP= message privé (désormais dans la nouvelle version du forum = Conversation)
(Si tu cliques sur l'enveloppe prés de ton pseudo, tu verras mon MP

garnote · 12 Octobre 2022

Bonsoir à tous,

À partir de la cellule jaune, j'écris les entiers de 1 à ... en spirale dans le sens antihoraire.
Sur cette image j'en suis rendu à un tableau 7 x 7, mais je voudrais continuer la spirale.
Et comme j'aimerais obtenir des tableaux gigantesques , genre 203 x 203, je ne peux
imaginer faire ça à mains nues! . Je cherche une macro pour faire le boulot,
mais je n'y arrive pas. Vous avez une idée ou deux à ce sujet "et consorts" ?

Bonne fin de soirée!

Staple1600 · 12 Octobre 2022

Bonsoir @garnote

En attendant les matheux pur jus, pour ta spirale "infernale"

Voici en m'inspirant de ton classeur du message#204 et quelques lectures sur le net, un petit complément.
NB: lancez plusieurs fois la macro Test_A pour voir les variantes.

VB:

Sub test_A()
ActiveSheet.DrawingObjects.Delete
Randomize 1600
DessinerCardioide 160, Application.RandBetween(0, 6)
End Sub
Sub test_B()
ActiveSheet.DrawingObjects.Delete
DessinerCardioide 500, 6
End Sub
Sub test_C()
ActiveSheet.DrawingObjects.Delete
DessinerCardioide 350, 51
End Sub

Private Sub DessinerCardioide(nbpts%, pas)
Dim r%, x0%, y0%, i%, j%, tablo As Variant, vPi As Double, TT As Double
Dim cercle As Shape, ligne As Shape
vPi = 4 * Atn(1): x0 = 250: y0 = 250: r = 200: npoints = nbpts: step = pas
'Ajout cercle
Set cercle = ActiveSheet.Shapes.AddShape(msoShapeOval, x0 - r, y0 - r, 2 * r, 2 * r)
cercle.Line.ForeColor.RGB = vbRed: cercle.Fill.ForeColor.RGB = vbBlack: cercle.Line.Weight = 0.1
ReDim tablo(1 To npoints, 1 To 2)
'Dessin points
For i = 1 To npoints
    TT = (i - 1) * 2 * vPi / npoints
    tablo(i, 1) = x0 + r * Cos(TT): tablo(i, 2) = y0 - r * Sin(TT)
    Set pts = ActiveSheet.Shapes.AddShape(9, tablo(i, 1) - 2, tablo(i, 2) - 2, 4, 4)
    pts.Line.ForeColor.RGB = vbBlue: pts.Fill.ForeColor.RGB = vbBlue
Next i
'Dessin Cardiode
j = npoints / 2 + 1
For i = 1 To npoints
Set ligne = ActiveSheet.Shapes.AddLine(tablo(i, 1), tablo(i, 2), tablo(j, 1), tablo(j, 2))
ligne.Line.ForeColor.RGB = vbRed: ligne.Line.Weight = 0.9
j = (j + step - 1) Mod npoints + 1
Next i
End Sub
'Crédits: garnote et Arnaldo Gunzi

garnote · 13 Octobre 2022

Staple1600 à dit:

Bonsoir @garnote

En attendant les matheux pur jus, pour ta spirale "infernale"

Voici en m'inspirant de ton classeur du message#204 et quelques lectures sur le net, un petit complément.
NB: lancez plus fois la macro Test_A pour voir les variantes.

VB:

Sub test_A()
ActiveSheet.DrawingObjects.Delete
Randomize 1600
DessinerCardioide 160, Application.RandBetween(0, 6)
End Sub
Sub test_B()
ActiveSheet.DrawingObjects.Delete
DessinerCardioide 500, 6
End Sub
Sub test_C()
ActiveSheet.DrawingObjects.Delete
DessinerCardioide 350, 51
End Sub

Private Sub DessinerCardioide(nbpts%, pas)
Dim r%, x0%, y0%, i%, j%, tablo As Variant, vPi As Double, TT As Double
Dim cercle As Shape, ligne As Shape
vPi = 4 * Atn(1): x0 = 250: y0 = 250: r = 200: npoints = nbpts: step = pas
'Ajout cercle
Set cercle = ActiveSheet.Shapes.AddShape(msoShapeOval, x0 - r, y0 - r, 2 * r, 2 * r)
cercle.Line.ForeColor.RGB = vbRed: cercle.Fill.ForeColor.RGB = vbBlack: cercle.Line.Weight = 0.1
ReDim tablo(1 To npoints, 1 To 2)
'Dessin points
For i = 1 To npoints
    TT = (i - 1) * 2 * vPi / npoints
    tablo(i, 1) = x0 + r * Cos(TT): tablo(i, 2) = y0 - r * Sin(TT)
    Set pts = ActiveSheet.Shapes.AddShape(9, tablo(i, 1) - 2, tablo(i, 2) - 2, 4, 4)
    pts.Line.ForeColor.RGB = vbBlue: pts.Fill.ForeColor.RGB = vbBlue
Next i
'Dessin Cardiode
j = npoints / 2 + 1
For i = 1 To npoints
Set ligne = ActiveSheet.Shapes.AddLine(tablo(i, 1), tablo(i, 2), tablo(j, 1), tablo(j, 2))
ligne.Line.ForeColor.RGB = vbRed: ligne.Line.Weight = 0.9
j = (j + step - 1) Mod npoints + 1
Next i
End Sub
'Crédits: garnote et Arnaldo Gunzi

Wow! De toute beauté et beaucoup de diversité. Je la copie pour tenter de la déchiffrer et la comprendre.

[Digressions] Shapes your booty, Fractales et consorts...

Dranreb

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

Dranreb

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

garnote

XLDnaute Junior

Pièces jointes

Staple1600

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

garnote

XLDnaute Junior

garnote

XLDnaute Junior

Pièces jointes

Staple1600

XLDnaute Barbatruc

garnote

XLDnaute Junior

Staple1600

XLDnaute Barbatruc

garnote

XLDnaute Junior

Pièces jointes

Staple1600

XLDnaute Barbatruc

garnote

XLDnaute Junior