Pentagon Fractal

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

pixels showing pentagon fractal

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

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

Posted in Uncategorized

5 thoughts on “Pentagon Fractal

  1. 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.


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

    My current valid email address is:

    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.

  2. Sub Tapis()
    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
    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
    End Sub
    Sub efface()
    Range(“Table”).Interior.ColorIndex = xlNone
    Range(“Table1?).Interior.ColorIndex = xlNone
    End Sub

Posting code? Use <pre> tags for VBA and <code> tags for inline.

Leave a Reply

Your email address will not be published.