Phyllotaxis

Fermat’s spiral,

R=\sqrt{\theta}

in polar coordinates where
R is the radial distance
theta is the angle from the starting horizontal line
3D spheres are placed on the spiral at 137.5 degree intervals.

 

 
screenshot_1-12-2016-2

screenshot_1-13-2016_1

screenshot_1-13-2016_3

screenshot_1-14-2016_4

i generated this one fooling around with color numbers 1-255 multiplying by 23, dividing by 255 and taking the remainder, whew, just trying to get a pattern.

screenshot_1-14-2016_6

'begin phyllotaxis structure
Sub draw_daisy()
    Call init_polar
    Dim strfunc As String
    Dim r As Double, A_rad As Double
    Dim X As Double, Y As Double
    Dim i As Integer, n As Integer
    Dim d As Double, circle_radius As Double
    Dim pt() As Double
    
    strfunc = frm_polar.txt_a2.Value
    n = frm_polar.txt_n.Text
    d = frm_polar.txt_d.Text
    circle_radius = frm_polar.txt_circle_radius.Text
    ReDim pt(1 To n * 2)
    
    For i = 1 To n
    'user works in degrees but trig functions use radians
    A_rad = deg2rad(i * d)
    r = eval_polar_func(strfunc, A_rad)
    X = r * Cos(A_rad)
    Y = r * Sin(A_rad)
    pt(i * 2 - 1) = X: pt(i * 2) = Y
    Next i
    
    Call draw_circles(pt, circle_radius)
   'Call draw_spheres(pt, circle_radius)
End Sub

Sub draw_circles(ByRef pt() As Double, circle_radius As Double)
    Dim i As Integer, numpts As Integer
    Dim x1 As Double, y1 As Double
    Dim circleobj As AcadCircle
    'dbl_thickness As Double)
    Dim pt1(0 To 2) As Double
    numpts = UBound(pt) / 2

    For i = 1 To numpts
        x1 = pt(i * 2 - 1)
        y1 = pt(i * 2)
        pt1(0) = x1: pt1(1) = y1: pt1(2) = 0
        Set circleobj = acadDoc.ModelSpace.AddCircle(pt1, circle_radius)
        'circleobj.Thickness = dbl_thickness
    Next i

   Update
End Sub

Sub draw_spheres(ByRef pt() As Double, circle_radius As Double)
    Dim objent As Acad3DSolid
    Dim i As Integer, numpts As Integer
    Dim x1 As Double, y1 As Double
    Dim pt1(0 To 2) As Double
    numpts = UBound(pt) / 2

    For i = 1 To numpts
        x1 = pt(i * 2 - 1)
        y1 = pt(i * 2)
        pt1(0) = x1: pt1(1) = y1: pt1(2) = 0
     Set objent = acadDoc.ModelSpace.AddSphere(pt1, circle_radius)
    Next i

   Update
End Sub

Function eval_polar_func(ByVal strfunc As String, A_rad As Double) As Double
On Error GoTo HandlError
Static errorcounter As Integer

strfunc = Replace(strfunc, "A", A_rad, , , vbTextCompare)
eval_polar_func = Evaluate(strfunc)

ExitHere:
Exit Function
'runtime error 13 type mismatch
HandlError:
If Err.number = 13 Then
MsgBox "type mismatch div by zero or bad equation"
eval_polar_func = ylim + 1
errorcounter = errorcounter + 1
If errorcounter = 3 Then
MsgBox "errorcounter at 3 - exiting"
End
End If

End If
End Function

screenshot_1-13-2016_2

screenshot_1-13-2016_4

screenshot_1-14-2016_8

screenshot_1-14-2016_9

Advertisements

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s