A helping VBA class was built before drawing the actual fractal.
The class provides flip operations for PowerPoint line shape elements.
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
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