Sunday, February 06, 2005

Drawing the Golden Ratio

Platform: AutoCAD 2004

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

Where is the function IsDimArray defined?
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

<< Home

This page is powered by Blogger. Isn't yours?

vba, acad vba, cad vba, cad, visual basic, visual basic for applications, autocad vba, acad vba, training, vba training, cad training, acad training, autocad training, autocad vba training, bom, bill of material, meta-data, meta data, metadata, property data, data, inventor properties, document management, document, management,technical support resource for users of Autodesk Mechanical CAD Software including Autodesk Inventor & Mechanical Desktop inventor, autodeskinventor, inventor 2, inventor 3, inventor 4, inventor 5, inventor 6, inventor7, inventor 8, inventor 9, inventor 10, autodesk inventor, autodesk inventor2, autodesk inventor 3, autodesk inventor 4, autodesk inventor 5, autodeskinventor 6, autodesk inventor 7, autodesk inventor 8, autodesk inventor9, autodesk inventor 10, inventor r, inventor r2, inventor r3, inventor r4, inventor r5, inventor r6, inventor r7, inventor r8, inventor r9, inventorr10, autodesk inventor, autodesk inventor r2, autodesk inventor r3, autodeskinventor r4, autodesk inventor r5, autodesk inventor r6, autodesk inventorr7, autodesk inventor r8, autodesk inventor r9, autodesk inventor r10,inventor series, autodesk inventor series, inventor series 5, inventorseries R5, autodesk inventor series 5, autodesk inventor series r5, inventorseries 6, inventor series R6, autodesk inventor series 6, autodesk inventorseries r6, inventor autodesk, autodesk inventor download, autodesk inventortutorial, autodesk inventor help, autodesk inventor faq, autodesk inventortips, autodesk inventor routines, autodesk inventor support, autodesk inventor, inventor download, inventor tutorial, inventor help, inventorfaq, inventor tips, inventor routines, inventor support, inventor, inventor help line, help for inventor, inventortraining, autodesk inventor training, mdt, mdt 4, mdt 5,mdt 6, mdt 7, mdt 8, mdt4, mdt5, mdt6, mdt7, mdt8, mdt 2000, mdt 2002,mdt r4, mdt r5, mdt r6, mdt r2000, mdt r2002, mechanical desktop, mechanicaldesktop 4, mechanical desktop 5, mechanical desktop 6, mechanical desktop7, mechanical desktop 2000, mechanical desktop 2002, autodesk, autodesk auto cad, autodesk inc,training, education, auto cad support, autocad support, mcad, autocad mechanical,mechanical, autocad mechanical 6, autocad mechanical 7, autocad mechanical8, autocad mechanical 9, autocad mechanical r6, autocad mechanical r7,autocad mechanical r8, autocad mechanical r9, support, help, tips, routines, reseller, mech, cad, acad, technical, ontario, canada, f.a.q.,faq, answers, resource, barrie, autolisp, auto lisp, autocad, auto cad, autocad desktop, auto cad desktop, autocad inventor, auto cadinventor, powerpack, MAI, desktop, cad software, autocad lt, auto cad lt,cad cam, cad design, cad job, job cad, autocad lisp, auto cad lisp, 3dcad software, 3d cad, free, free cad software, service pack, render, system, computer, aided, drafting, design, manufacturing, modeling, solidmodeling, solid modelling