I couldn’t resist trying it with some other regular polygons. Here’s how the pentagon worked out

I think, given more time, that those white blotches would be pentagons. The 50k iterations just didn’t get the job done. I had to up the ante to 5,000,000 iterations – 42 minutes on my machine (Triangle Fractal took 42 seconds). If I could (was willing to) get rid of the randomness, I’m sure it could be done much faster. But then it would lose its charm. Here’s the code

Sub SheetPolygon()

Dim CurrX As Double

Dim CurrY As Double

Dim Vertices(1 To 5, 1 To 2) As Double

Dim NextVert As Long

Dim i As Long

Dim wsh As Worksheet

Dim lMaxVert As Long

Dim lStart As Long

Dim c1 As Double, c2 As Double, s1 As Double, s2 As Double

Const XOFF As Long = 128

Const YOFF As Long = 128

Const PI = 3.14159265358979

Warning: don‘t run this code unless you have some time

lStart = Timer

c1 = Cos(2 * PI / 5)

c2 = Cos(PI / 5)

s1 = Sin(2 * PI / 5)

s2 = Sin(4 * PI / 5)

Vertices(1, 1) = XOFF + 0

Vertices(1, 2) = YOFF – 127

Vertices(2, 1) = XOFF + (s1 * XOFF)

Vertices(2, 2) = YOFF – (c1 * YOFF)

Vertices(3, 1) = XOFF + (s2 * XOFF)

Vertices(3, 2) = YOFF + (c2 * YOFF)

Vertices(4, 1) = XOFF – (s2 * XOFF)

Vertices(4, 2) = YOFF + (c2 * YOFF)

Vertices(5, 1) = XOFF – (s1 * XOFF)

Vertices(5, 2) = YOFF – (c1 * YOFF)

Set wsh = ThisWorkbook.Worksheets.Add

wsh.Cells.RowHeight = 1.5

wsh.Cells.ColumnWidth = 0.17

lMaxVert = UBound(Vertices, 1)

NextVert = lMaxVert

CurrX = Vertices(NextVert, 1)

CurrY = Vertices(NextVert, 2)

‘loop ten thousand times

For i = 1 To 5000000

NextVert = Int(lMaxVert * Rnd + 1) ‘pick a random vertex

GetNewPoint CurrX, CurrY, Vertices(NextVert, 1), Vertices(NextVert, 2)

PlacePointWsh CLng(CurrX), CLng(CurrY), wsh

Next i

Debug.Print Timer – lStart

End Sub

Dim CurrX As Double

Dim CurrY As Double

Dim Vertices(1 To 5, 1 To 2) As Double

Dim NextVert As Long

Dim i As Long

Dim wsh As Worksheet

Dim lMaxVert As Long

Dim lStart As Long

Dim c1 As Double, c2 As Double, s1 As Double, s2 As Double

Const XOFF As Long = 128

Const YOFF As Long = 128

Const PI = 3.14159265358979

Warning: don‘t run this code unless you have some time

lStart = Timer

c1 = Cos(2 * PI / 5)

c2 = Cos(PI / 5)

s1 = Sin(2 * PI / 5)

s2 = Sin(4 * PI / 5)

Vertices(1, 1) = XOFF + 0

Vertices(1, 2) = YOFF – 127

Vertices(2, 1) = XOFF + (s1 * XOFF)

Vertices(2, 2) = YOFF – (c1 * YOFF)

Vertices(3, 1) = XOFF + (s2 * XOFF)

Vertices(3, 2) = YOFF + (c2 * YOFF)

Vertices(4, 1) = XOFF – (s2 * XOFF)

Vertices(4, 2) = YOFF + (c2 * YOFF)

Vertices(5, 1) = XOFF – (s1 * XOFF)

Vertices(5, 2) = YOFF – (c1 * YOFF)

Set wsh = ThisWorkbook.Worksheets.Add

wsh.Cells.RowHeight = 1.5

wsh.Cells.ColumnWidth = 0.17

lMaxVert = UBound(Vertices, 1)

NextVert = lMaxVert

CurrX = Vertices(NextVert, 1)

CurrY = Vertices(NextVert, 2)

‘loop ten thousand times

For i = 1 To 5000000

NextVert = Int(lMaxVert * Rnd + 1) ‘pick a random vertex

GetNewPoint CurrX, CurrY, Vertices(NextVert, 1), Vertices(NextVert, 2)

PlacePointWsh CLng(CurrX), CLng(CurrY), wsh

Next i

Debug.Print Timer – lStart

End Sub

You’ll need to get GetNewPoint and PlacePointWsh from Triangle Fractal. I got the vertices from MathWorld.

I have been playing with Fractals for many years and was recently given a challenge at a meeting where I had stated “Why don’t we do that in Excel? You can do everything in Excel”.

“You Can’t make Mandelbrots without using code” came the response.

So 1 Hr later here is Excel_Madlbrot.xls with a graphics output and no VBA code.

http://www.ianeva.info/Excel_Mandelbrot/Excel_Mandelbrot.html

Hui…

Hui,

That is amazing! I’m going to waste hours on figuring out how you did it.

Rob

Wow Hui!

I am totally blown away by that.

If I had a spare day or two, I might have looked into how you did it, but then again, I sometimes think that knowing why a sunset happens actually takes something away from the experience so perhaps I’ll just remain in awe.

Alan.

The views expressed are my own, and not those of my employer or anyone else associated with me.

My current valid email address is:

6f7chu602@sneakemail.com

This is valid as is. It is not munged, or altered at all.

It will be valid for AT LEAST one month from the date of this post.

If you are trying to contact me after that time,

it MAY still be valid, but may also have been

deactivated due to spam. If so, and you want

to contact me by email, try searching for a

more recent post by me to find my current

email address.

Alan –

Here’s how it works, but you have to promise not to tell anyone.

It’s magic!

– Jon

Sub Tapis()

‘Autor?

ActiveSheet.Unprotect

Randomize

couleur = Int(28 * Rnd + 3)

For Each fou In Range(“Table”)

If fou.Value 0 And fou.Value Mod 2 = 0 Then fou.Interior.ColorIndex = couleur

Next fou

Randomize

couleur = Int(28 * Rnd + 3)

For Each la In Range(“Table1?)

If la.Value 0 And la.Value Mod 2 = 1 Then la.Interior.ColorIndex = couleur

Next la

ActiveSheet.Protect

End Sub

Sub efface()

ActiveSheet.Unprotect

Range(“Table”).Interior.ColorIndex = xlNone

Range(“Table1?).Interior.ColorIndex = xlNone

ActiveSheet.Protect

End Sub