### Sunday, February 06, 2005

## Drawing the Golden Ratio

Platform: AutoCAD 2004

Download: GoldenRatio.zip

The Golden Ratio has always fascinated me. I'm no math wizard but the Golden Ration (also known as Phi) has a tendency to turn up in a great number of places: the spiral of a sea shell, the swirl of milk in coffee, clouds, crop circles, and the list goes on. I highly recommend a movie directed by Darren Aronofsky, a very odd but interesting movie from 1998 entitled Pi (IMDB link) that touches on Phi and Fibonacci sequences.

Fibonacci sequences occur when any term after the first two can be found by summing the two previous terms. Here's an example: 1, 1, 2, 3, 5, 8, 13, ...

I'll point you to the two links below for full details on Phi and Fibonacci sequences:

We can calculate a Fibonacci sequence with this function:

Public Function Fibonacci(ByVal lngNumber As Long) As Long

On Error GoTo ErrorHandler

If lngNumber <= 1 Then ' ignore negatives

Fibonacci = 0

ElseIf lngNumber = 2 Then

Fibonacci = 1

Else ' return the fibonacci number

Fibonacci = Fibonacci(lngNumber - 1) + Fibonacci(lngNumber - 2)

End If

Exit Function

ErrorHandler:

End Function

The trickiest part of the routine was resetting the start point for the arc as it moves every iteration of the loop. First, Add a constant for PI, then add the routine below.

Public Const PI = 3.14159265358979 ' 3.1415926535897932384626433832795 or atn(1.0)*4

Public Sub AddGoldenRatio(lngQuads As Long)

' Draw the golden ratio (PHI) starting at 0,0 and spiral out

On Error GoTo ErrorHandler

Dim objArc As AcadArc

Dim pt1(0 To 2) As Double

Dim lngCorner As Long ' Start corner: 0=SW, 1=SE, 2=NE, 3=NW

Dim dblLength As Double ' Length of a side.

Dim dblLast As Double ' Last Length

Dim dblAngleStart As Double ' Start angle of arc

Dim dblAngleEnd As Double ' End angle of arc

Dim i As Long

lngCorner = 0 ' Draw first square from 0,0

dblLength = 1 ' Start with a 1x1 square

pt1(0) = 0#: pt1(1) = 0# ' Center point of arc

dblAngleStart = 0# ' Start at 0 deg

dblAngleEnd = 90# * (PI / 180#) ' Start at 90 deg (converted to radians)

' Start at 4 to skip duplicates in Fibonacci sequence

' Add 3 to compensate

For i = 4 To lngQuads + 3

' Add arc to modelspace

Set objArc = ThisDrawing.ModelSpace.AddArc(pt1, dblLength, dblAngleStart, dblAngleEnd)

' Update angles

dblAngleStart = dblAngleEnd

dblAngleEnd = dblAngleEnd + 90# * (PI / 180#)

' Set lengths

dblLast = dblLength

dblLength = Fibonacci(i)

' Move our startpoint

Select Case lngCorner

Case 0

pt1(0) = pt1(0)

pt1(1) = pt1(1) - (dblLength - dblLast)

Case 1

pt1(0) = pt1(0) + (dblLength - dblLast)

pt1(1) = pt1(1)

Case 2

pt1(0) = pt1(0)

pt1(1) = pt1(1) + (dblLength - dblLast)

Case 3

pt1(0) = pt1(0) - (dblLength - dblLast)

pt1(1) = pt1(1)

End Select

' Incerement our corner

lngCorner = lngCorner + 1

If lngCorner = 4 Then lngCorner = 0

Next i

' Clean up

Set objArc = Nothing

If IsDimArray(pt1) Then Erase pt1

Exit Sub

ErrorHandler:

Set objArc = Nothing

If IsDimArray(pt1) Then Erase pt1

End Sub

Update: I forgot to add the IsDimArray function. You can thank Jimmy Bergmark for catching my mistake. The IsDimArray function checks to see if an array has been dimensioned yet and reurns a boolean.

Public Function IsDimArray(arr As Variant) As Boolean

On Error GoTo ErrorHandler

Dim i As Long

i = UBound(arr)

If Not i = -1 Then IsDimArray = True

Exit Function

ErrorHandler:

IsDimArray = False

End Function

Not sure if you can find any technical use for this, but I hope I have peaked you interest into this interesting corner of mathematics. To call the routine add a sub like below:

Private Sub DrawGoldenRatio()

Call AddGoldenRatio(8)

End Sub

Download: GoldenRatio.zip

The Golden Ratio has always fascinated me. I'm no math wizard but the Golden Ration (also known as Phi) has a tendency to turn up in a great number of places: the spiral of a sea shell, the swirl of milk in coffee, clouds, crop circles, and the list goes on. I highly recommend a movie directed by Darren Aronofsky, a very odd but interesting movie from 1998 entitled Pi (IMDB link) that touches on Phi and Fibonacci sequences.

Fibonacci sequences occur when any term after the first two can be found by summing the two previous terms. Here's an example: 1, 1, 2, 3, 5, 8, 13, ...

I'll point you to the two links below for full details on Phi and Fibonacci sequences:

We can calculate a Fibonacci sequence with this function:

Public Function Fibonacci(ByVal lngNumber As Long) As Long

On Error GoTo ErrorHandler

If lngNumber <= 1 Then ' ignore negatives

Fibonacci = 0

ElseIf lngNumber = 2 Then

Fibonacci = 1

Else ' return the fibonacci number

Fibonacci = Fibonacci(lngNumber - 1) + Fibonacci(lngNumber - 2)

End If

Exit Function

ErrorHandler:

End Function

The trickiest part of the routine was resetting the start point for the arc as it moves every iteration of the loop. First, Add a constant for PI, then add the routine below.

Public Const PI = 3.14159265358979 ' 3.1415926535897932384626433832795 or atn(1.0)*4

Public Sub AddGoldenRatio(lngQuads As Long)

' Draw the golden ratio (PHI) starting at 0,0 and spiral out

On Error GoTo ErrorHandler

Dim objArc As AcadArc

Dim pt1(0 To 2) As Double

Dim lngCorner As Long ' Start corner: 0=SW, 1=SE, 2=NE, 3=NW

Dim dblLength As Double ' Length of a side.

Dim dblLast As Double ' Last Length

Dim dblAngleStart As Double ' Start angle of arc

Dim dblAngleEnd As Double ' End angle of arc

Dim i As Long

lngCorner = 0 ' Draw first square from 0,0

dblLength = 1 ' Start with a 1x1 square

pt1(0) = 0#: pt1(1) = 0# ' Center point of arc

dblAngleStart = 0# ' Start at 0 deg

dblAngleEnd = 90# * (PI / 180#) ' Start at 90 deg (converted to radians)

' Start at 4 to skip duplicates in Fibonacci sequence

' Add 3 to compensate

For i = 4 To lngQuads + 3

' Add arc to modelspace

Set objArc = ThisDrawing.ModelSpace.AddArc(pt1, dblLength, dblAngleStart, dblAngleEnd)

' Update angles

dblAngleStart = dblAngleEnd

dblAngleEnd = dblAngleEnd + 90# * (PI / 180#)

' Set lengths

dblLast = dblLength

dblLength = Fibonacci(i)

' Move our startpoint

Select Case lngCorner

Case 0

pt1(0) = pt1(0)

pt1(1) = pt1(1) - (dblLength - dblLast)

Case 1

pt1(0) = pt1(0) + (dblLength - dblLast)

pt1(1) = pt1(1)

Case 2

pt1(0) = pt1(0)

pt1(1) = pt1(1) + (dblLength - dblLast)

Case 3

pt1(0) = pt1(0) - (dblLength - dblLast)

pt1(1) = pt1(1)

End Select

' Incerement our corner

lngCorner = lngCorner + 1

If lngCorner = 4 Then lngCorner = 0

Next i

' Clean up

Set objArc = Nothing

If IsDimArray(pt1) Then Erase pt1

Exit Sub

ErrorHandler:

Set objArc = Nothing

If IsDimArray(pt1) Then Erase pt1

End Sub

Update: I forgot to add the IsDimArray function. You can thank Jimmy Bergmark for catching my mistake. The IsDimArray function checks to see if an array has been dimensioned yet and reurns a boolean.

Public Function IsDimArray(arr As Variant) As Boolean

On Error GoTo ErrorHandler

Dim i As Long

i = UBound(arr)

If Not i = -1 Then IsDimArray = True

Exit Function

ErrorHandler:

IsDimArray = False

End Function

Not sure if you can find any technical use for this, but I hope I have peaked you interest into this interesting corner of mathematics. To call the routine add a sub like below:

Private Sub DrawGoldenRatio()

Call AddGoldenRatio(8)

End Sub

Comments:

<< Home

I was looking for some AutoCAD training and found this new site for

auto cad online training along with your site. Have you seen this one yet?

Post a Comment
auto cad online training along with your site. Have you seen this one yet?

<< Home