Draw a Pythagoras Tree with Microsoft PowerPoint (VBA) ## Abstract

This article describes how to draw a Pythagoras Tree in Microsoft PowerPoint using Visual Basic for Applications (VBA).

## Motivation

A Pythagoras Tree is a simple yet beautiful fractal named after the ancient Greek mathematician Pythagoras. The consulity company logo contains parts of this fractal and therefore VBA and PowerPoint was given a try to paint this fractal. The PowerPoint VBA API offers a function to draw a line wich is practically all it takes to draw the tree.

## Objective

Draw a Pythagoras Tree with PowerPoint VBA for a given depth.

## Setup

In VBA some Types, Constants and helping procedures, e.g. paintAngleFromPoint, paintTriangle, paintSquare were built. With paintAngleFromPoint, one can draw almost anything. Of course one could have used existing shapes of PowerPoint, i.e. squares and triangles to paint the tree, but the function to draw the line (actually a vector) is considered the more versatile option.

## Results ### 11 Iterations ### 15 Iterations ## Source Code

Option Explicit

Type Point

X As Double

Y As Double

End Type

Type Triangle

ptA As Point

ptB As Point

ptC As Point

AC As Double

BC As Double

BD As Double

CD As Double

Alpha As Double

Beta As Double

End Type

Type Square

ptA As Point

ptB As Point

End Type

Type PythagoreanTree

tBase As Triangle

sLeft As Square

sRight As Square

End Type

Public Const Pi As Double = 3.14159265358979

Public Const Pi180 As Double = 0.0174532925199433

Function GM() As Double

GM = (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,

Radius As Double, Optional Color As Long) As Point

Dim SinL As Double

Dim CosL As Double

angle = angle * Pi180

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

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

paintAngleFromPoint.X = ptStart.X + SinL

paintAngleFromPoint.Y = ptStart.Y - CosL

End Function

Function paintTriangle(ptStart As Point, ByVal angle As Double, Radius As Double) As Triangle

' computation of lengths (pythagorean theorem)

'k = Sqr((np.Y - p.Y) ^ 2 + (l * gm) ^ 2)

'Const LNGCOLOR As Long = 16711680

Dim LNGCOLOR As Long

Dim colorPalette As Variant

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))

Dim ptNew As Point

Dim AC As Double ' segment C to B

' new point is given starting point

ptNew = ptStart

' computation of opposite leg radius

AC = Sin(ARCCOS(GM) * Pi180) * Radius ' 78.6151377757423

Dim XOffset As Double

Dim YOffset As Double

Dim Beta As Double

Dim Alpha As Double, rotAlpha

' compute X starting point for initial rotation

Beta = Cos(angle * Pi180)

XOffset = Radius * (1 - Beta) / 2

'ptNew.X = ptStart.X + XOffset

' compute Y starting point for initial rotation

Alpha = Sin(angle * Pi180)

YOffset = Radius * Alpha / 2

'ptNew.Y = ptStart.Y - YOffset

' hypothenuse

Call paintAngleFromPoint(ptNew, 90 + angle, Radius, LNGCOLOR)

paintTriangle.ptA = ptNew

ptNew = paintAngleFromPoint(ptNew, ARCCOS(GM) + angle, AC, LNGCOLOR)

paintTriangle.ptC = ptNew

' opposite leg

ptNew = paintAngleFromPoint(ptNew, 90 + ARCCOS(GM) + angle, GM() * Radius, LNGCOLOR)

paintTriangle.ptB = ptNew

' set return value (struct)

With paintTriangle

.AC = AC

.BC = Cos(ARCCOS(GM) * Pi180) * Radius

.CD = Cos(ARCSIN(GM) * Pi180) * GM() * Radius

.BD = (1 - GM()) * Radius

.Alpha = ARCSIN(GM)

.Beta = ARCCOS(GM)

End With

End Function

Function paintSquare(ptStart As Point, ByVal angle As Double, Radius As Double) As Square

Dim ptNew As Point

Dim CB As Double ' segment C to B

Dim LNGCOLOR As Long

Dim colorPalette As Variant

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))

' new point is given starting point

ptNew = ptStart

' 1st leg

ptNew = paintAngleFromPoint(ptStart, angle, Radius, LNGCOLOR)

paintSquare.ptA = ptNew

' 2nd leg

ptNew = paintAngleFromPoint(ptNew, 90 + angle, Radius, LNGCOLOR)

paintSquare.ptB = ptNew

' 3rd leg

ptNew = paintAngleFromPoint(ptNew, 180 + angle, Radius, LNGCOLOR)

End Function

Sub main()

Dim p As Point

p.X = 330

p.Y = 400

Dim newSlide As Slide

Set newSlide = ActivePresentation.Slides.AddSlide(ActivePresentation.Slides.Count + 1, _

ActivePresentation.SlideMaster.CustomLayouts(7))

newSlide.Select

Call paintPythagoreanTree(p, 0, 100, 1, 15)

End Sub

Function paintPythagoreanTree(ByRef p As Point, ByVal iAngle As Double,

ByVal l As Double, ByVal i As Integer, ByVal depth As Integer)

Dim t As Triangle

Dim sl As Square

Dim sr As Square

Dim pt As Point

' paint base triangle

t = paintTriangle(p, iAngle, l)

' paint left square

sl = paintSquare(t.ptA, (360 - t.Alpha) * i + iAngle + (i - 1) * t.Alpha, t.AC)

If i <= depth Then

pt = sl.ptA

Call paintPythagoreanTree(pt, (360 - t.Alpha) * i + iAngle + (i - 1) * t.Alpha, t.AC, i + 1, depth)

End If

' right sqare

sr = paintSquare(t.ptC, iAngle - t.Alpha + 90, t.BC)

If i <= depth Then

pt = sr.ptA

Call paintPythagoreanTree(pt, iAngle + t.Beta, t.BC, i + 1, depth)

End If

End Function

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

## Sketchess 