Draw a Koch Snowflake with Microsoft PowerPoint (VBA)

Abstract

This article demonstrates how to draw a Koch snowflake, a simple yet beatiful fractal, with Microsoft PowerPoint using Visual Basic for Applications (VBA).

Objective

Draw the fractal for any shape (consisting of single lines) for a given depth (=number of iterations).

Setup

The fractal is a simple algorithm using a line, divide into three equal parts, replace the inner part with two legs of a isosceles triangle. The last leg (the inner part of the initial line) is simply omitted. As this procedure is then repeated over and over again the drawing becomes more and more detailed.

First steps

Single line, 5 iterations

Triangle line, 5 iterations

Square line, 5 iterations

Source Code

A helping VBA class was built before drawing the actual fractal. The class provides flip operations for PowerPoint line shape elements.

clsLine

Option Explicit

 

Public t As Long ' top

Public l As Long ' left

Public w As Double ' width

Public h As Double ' height

Public hf As Boolean ' horizontal flip

 

Public ol As Shape ' object line (shape)

 

Public Property Get length() As Double

    length = Sqr(ol.Width ^ 2 + ol.Height ^ 2)

End Property

 

Public Property Let setLength(ByVal l As Double)

 

End Property

 

Public Function ps() As Point ' end point

 

    Dim tp As Point

 

    If Not ol.HorizontalFlip Then

        tp.x = ol.Left

        tp.Y = ol.Top + IIf(ol.VerticalFlip, ol.Height, 0)

    Else

        tp.x = ol.Left + ol.Width

        tp.Y = ol.Top + IIf(ol.VerticalFlip, ol.Height, 0)

    End If

    ps = tp

 

End Function

 

Public Function pe() As Point ' end point

 

    Dim tp As Point

 

    If ol.HorizontalFlip Then

        tp.x = ol.Left

        tp.Y = ol.Top + IIf(ol.VerticalFlip, 0, ol.Height)

 

    Else

        tp.x = ol.Left + ol.Width

        tp.Y = ol.Top + IIf(ol.VerticalFlip, 0, ol.Height)

    End If

    pe = tp

End Function

 

Public Function angle() As Double ' angle start-end

 

    If ps.x = pe.x Then

        angle = 0

    Else

        ' compute cos

        Dim cos As Double

        cos = ol.Height / Me.length

        angle = ARCCOS(cos)

 

    End If

 

    If ol.HorizontalFlip And ol.VerticalFlip Then

        angle = 360 - angle

    ElseIf ol.HorizontalFlip And Not ol.VerticalFlip Then

        angle = 180 + angle

    ElseIf Not ol.VerticalFlip And Not ol.HorizontalFlip Then

        angle = 180 - angle

    Else

    End If

 

End Function

 

 

basKochSnowFlake

Option Explicit

 

Public Type Point

    x As Double

    Y As Double

End Type

 

Public Const Pi As Double = 3.14159265358979

Public Const Pi180 As Double = 0.0174532925199433

 

Function GM() As Double

    GM = 0.55 '(Sqr(5) - 1) / 2

End Function

 

Function ARCSIN(ByVal dblSinus As Double) As Double

    ARCSIN = Atn(dblSinus / Sqr(-dblSinus * dblSinus + 1)) / Pi180

End Function

 

Function ARCCOS(ByVal dblCosinus As Double) As Double

    ARCCOS = (Atn(-dblCosinus / Sqr(-dblCosinus * dblCosinus + 1)) + 2 * Atn(1)) / Pi180

End Function

 

Function paintAngleFromPoint(ptStart As Point, ByVal angle As Double,

                             ByVal Radius As Double, Optional Color As Long) As Point

 

    Dim SinL As Double

    Dim CosL As Double

 

    angle = angle * Pi180

 

    SinL = Sin(angle) * Radius

    CosL = cos(angle) * Radius

 

    ActiveWindow.Selection.SlideRange.Shapes.AddLine(ptStart.x, ptStart.Y, ptStart.x + SinL, ptStart.Y - CosL).Select

    Dim r As Long

    Dim g As Long

    Dim b As Long

 

    Dim colorPalette As Variant

    Dim lngColor As Long

    colorPalette = Array(RGB(0, 104, 204), RGB(28, 142, 252), RGB(6, 133, 255), RGB(0, 78, 153), RGB(0, 61, 120))

    'colorPalette = Array(RGB(69, 106, 168), RGB(153, 178, 221), RGB(104, 137, 194), RGB(45, 85, 153), RGB(24, 62, 126))

    lngColor = colorPalette(RAND_INT(0, 4))

 

    ActiveWindow.Selection.ShapeRange.Line.ForeColor.RGB = lngColor 'Color

    ActiveWindow.Selection.ShapeRange.Line.Weight = 0.5 '1.5

 

    paintAngleFromPoint.x = ptStart.x + SinL

    paintAngleFromPoint.Y = ptStart.Y - CosL

 

End Function

 

Sub paintBaseShape(ByVal ol As clsLine)

 

    Dim p As Point

    p = ol.ps

    Dim se As Double

    Dim r As Double

    se = ol.angle - 90

    r = ol.length / 3

    p = paintAngleFromPoint(p, se + 90, r)

    p = paintAngleFromPoint(p, se + 30, r)

    p = paintAngleFromPoint(p, se + 150, r)

    p = paintAngleFromPoint(p, se + 90, r)

 

End Sub

 

Sub main()

 

    Dim o As clsLine

    Dim i As Long

   

    Set o = New clsLine

    Set o.ol = ActiveWindow.Selection.SlideRange.Shapes(1)

   

    Dim c As New Collection

 

    For i = 1 To ActiveWindow.Selection.SlideRange.Shapes.Count

        c.Add ActiveWindow.Selection.SlideRange.Shapes(i).Name

    Next

 

    Dim e As Variant

    For Each e In c

        Set o = New clsLine

        Set o.ol = ActiveWindow.Selection.SlideRange.Shapes(e)

        paintBaseShape o

        ActiveWindow.Selection.SlideRange.Shapes(e).Delete

    Next

 

End Sub

 

Sub drawKochSnowFlake()

    Dim n As Integer

    Dim depth As Integer

    depth = 5

    For n = 1 To depth

        Call main()

    Next

End Sub

 

Sub drawTriangle()

    Dim p As Point

    p.x = 100 : p.Y = 100

    p = paintAngleFromPoint(p, 90, 200)

    p = paintAngleFromPoint(p, 210, 200)

    p = paintAngleFromPoint(p, 330, 200)

 

End Sub

 

Sub drawSquare()

    Dim p As Point

    p.x = 100 : p.Y = 100

    p = paintAngleFromPoint(p, 90, 200)

    p = paintAngleFromPoint(p, 180, 200)

    p = paintAngleFromPoint(p, 270, 200)

    p = paintAngleFromPoint(p, 360, 200)

End Sub

 

Sub drawAny()

 

    Dim p As Point

    Dim length As Integer

    Dim i As Integer

    p.x = 300 : p.Y = 300

    Dim angle As Integer

    angle = 90  ' <-- define this angle, e.g. 90° for a square

    length = 100 ' <-- define this as line length

    For i = 0 To (360 / angle)

        p = paintAngleFromPoint(p, i * angle, length)

    Next

 

End Sub

 

Function RAND_INT(ByVal l As Long, ByVal u As Long, Optional recalc_trigger) As Long

 

    Randomize

    RAND_INT = Int((u - l + 1) * Rnd + l)

 

End Function

 


Dieter Neumann