### Rh4_060507_GrowingAlgorythm

AA STUDENTS PAVILON (discovered in the BD of last week)

Design by a student of the AA Unit of Charles Walker & Martin Self (both ARUP AGU)

Here is my first test on growing algorythm...

Highly inspired but for sure yet much less sophisticated...

L-system, fractals are now very trendy...

Option Explicit

Sub tree()

' ------------------------------------------------------

' seed radius

Dim intCircleRadius: intCircleRadius = 20

' growing tesselation

Dim intSubDivide: intSubDivide = 3

' growing twist differentation

Dim dblAngle : dblAngle = 120

' ------------------------------------------------------

'Dim arrCircles() 'dynamic array

Dim strCircle1, strCircle2, strCircle3, strCircle4, strCircle5

Dim arrCircGen1, arrCircGen2, arrCircGen3, arrCircGen4, arrCircGen5

' ------------------------------------------------------

' addRootCircle

Dim arrPlane: arrPlane = Rhino.WorldXYPlane

Dim strCircle: strCircle = Rhino.AddCircle (arrPlane, intCircleRadius)

' ------------------------------------------------------

arrCircGen1 = Subdiv (strCircle,intSubDivide,dblAngle)

For Each strCircle1 In arrCircGen1

arrCircGen2 = Subdiv (strCircle1,intSubDivide,dblAngle)

For Each strCircle2 In arrCircGen2

arrCircGen3 = Subdiv (strCircle2,intSubDivide,dblAngle)

For Each strCircle3 In arrCircGen3

arrCircGen4 = Subdiv (strCircle3,intSubDivide,dblAngle)

For Each strCircle4 In arrCircGen4

'arrCircGen5 = Subdiv (strCircle4,intSubDivide,dblAngle)

'For Each strCircle5 In arrCircGen5

Subdiv strCircle4,intSubDivide,dblAngle

'to be changed each time less growth

'Next

Next

Next

Next

Next

' ------------------------------------------------------

End Sub

' ------------------------------------------------------

Function Subdiv(strCircle,intSubDivide,dblAngle)

' getCenter

Dim arrPtCenter: arrPtCenter = Rhino.CircleCenterPoint(strCircle)

' subdiv

Dim arrPts: arrPts = Rhino.DivideCurve (strCircle, intSubDivide)

Dim i

For i = 0 To UBound(arrPts)

Randomize

' addRadial

Dim strRadial : strRadial = Rhino.AddLine (arrPtCenter, arrPts(i))

' collectOriginalEndPt

ReDim Preserve arrEndPtCollect(UBound(arrPts))

arrEndPtCollect(i) = Rhino.CurveEndPoint(strRadial)

' setLength

' ------------------------------------------------------

Dim dblLengthExtend : dblLengthExtend = 1/3*Rhino.CurveLength(strRadial)

' ------------------------------------------------------

Rhino.ExtendCurveLength strRadial, 0, 1, dblLengthExtend

' setNewOrigine

Dim arrEndPt: arrEndPt = Rhino.CurveEndPoint(strRadial)

' setNewRadius

Dim dblLengthRad: dblLengthRad = Rhino.CurveLength(strRadial)

' ------------------------------------------------------

Dim dblCircleRadius: dblCircleRadius = dblLengthRad/2

' ------------------------------------------------------

' setNewPlane

Dim arrDirection: arrDirection = Array( arrEndPt(0), arrEndPt(1), arrEndPt(2)+1 )

Dim arrPlane: arrPlane = Rhino.PlaneFromPoints(arrEndPt, arrPtCenter, arrDirection)

Dim arrRotated: arrRotated = RotatePlane(arrPlane, dblAngle, arrPlane(1))

' addNewCircle

ReDim Preserve arrCircles(i)

arrCircles(i) = Rhino.AddCircle (arrRotated, dblCircleRadius)

Next

' addCurve

Dim strPerimeter: strPerimeter = Rhino.addCurve ( Array(arrEndPtCollect(0),arrPtCenter,_ arrEndPtCollect(1),arrPtCenter,_ arrEndPtCollect(2),arrPtCenter,_

arrEndPtCollect(0)) )

' createSurf

Rhino.AddPlanarSrf Array(strPerimeter)

' returnFunction

Subdiv = arrCircles

End Function

Design by a student of the AA Unit of Charles Walker & Martin Self (both ARUP AGU)

Here is my first test on growing algorythm...

Highly inspired but for sure yet much less sophisticated...

L-system, fractals are now very trendy...

Option Explicit

Sub tree()

' ------------------------------------------------------

' seed radius

Dim intCircleRadius: intCircleRadius = 20

' growing tesselation

Dim intSubDivide: intSubDivide = 3

' growing twist differentation

Dim dblAngle : dblAngle = 120

' ------------------------------------------------------

'Dim arrCircles() 'dynamic array

Dim strCircle1, strCircle2, strCircle3, strCircle4, strCircle5

Dim arrCircGen1, arrCircGen2, arrCircGen3, arrCircGen4, arrCircGen5

' ------------------------------------------------------

' addRootCircle

Dim arrPlane: arrPlane = Rhino.WorldXYPlane

Dim strCircle: strCircle = Rhino.AddCircle (arrPlane, intCircleRadius)

' ------------------------------------------------------

arrCircGen1 = Subdiv (strCircle,intSubDivide,dblAngle)

For Each strCircle1 In arrCircGen1

arrCircGen2 = Subdiv (strCircle1,intSubDivide,dblAngle)

For Each strCircle2 In arrCircGen2

arrCircGen3 = Subdiv (strCircle2,intSubDivide,dblAngle)

For Each strCircle3 In arrCircGen3

arrCircGen4 = Subdiv (strCircle3,intSubDivide,dblAngle)

For Each strCircle4 In arrCircGen4

'arrCircGen5 = Subdiv (strCircle4,intSubDivide,dblAngle)

'For Each strCircle5 In arrCircGen5

Subdiv strCircle4,intSubDivide,dblAngle

'to be changed each time less growth

'Next

Next

Next

Next

Next

' ------------------------------------------------------

End Sub

' ------------------------------------------------------

Function Subdiv(strCircle,intSubDivide,dblAngle)

' getCenter

Dim arrPtCenter: arrPtCenter = Rhino.CircleCenterPoint(strCircle)

' subdiv

Dim arrPts: arrPts = Rhino.DivideCurve (strCircle, intSubDivide)

Dim i

For i = 0 To UBound(arrPts)

Randomize

' addRadial

Dim strRadial : strRadial = Rhino.AddLine (arrPtCenter, arrPts(i))

' collectOriginalEndPt

ReDim Preserve arrEndPtCollect(UBound(arrPts))

arrEndPtCollect(i) = Rhino.CurveEndPoint(strRadial)

' setLength

' ------------------------------------------------------

Dim dblLengthExtend : dblLengthExtend = 1/3*Rhino.CurveLength(strRadial)

' ------------------------------------------------------

Rhino.ExtendCurveLength strRadial, 0, 1, dblLengthExtend

' setNewOrigine

Dim arrEndPt: arrEndPt = Rhino.CurveEndPoint(strRadial)

' setNewRadius

Dim dblLengthRad: dblLengthRad = Rhino.CurveLength(strRadial)

' ------------------------------------------------------

Dim dblCircleRadius: dblCircleRadius = dblLengthRad/2

' ------------------------------------------------------

' setNewPlane

Dim arrDirection: arrDirection = Array( arrEndPt(0), arrEndPt(1), arrEndPt(2)+1 )

Dim arrPlane: arrPlane = Rhino.PlaneFromPoints(arrEndPt, arrPtCenter, arrDirection)

Dim arrRotated: arrRotated = RotatePlane(arrPlane, dblAngle, arrPlane(1))

' addNewCircle

ReDim Preserve arrCircles(i)

arrCircles(i) = Rhino.AddCircle (arrRotated, dblCircleRadius)

Next

' addCurve

Dim strPerimeter: strPerimeter = Rhino.addCurve ( Array(arrEndPtCollect(0),arrPtCenter,_ arrEndPtCollect(1),arrPtCenter,_ arrEndPtCollect(2),arrPtCenter,_

arrEndPtCollect(0)) )

' createSurf

Rhino.AddPlanarSrf Array(strPerimeter)

' returnFunction

Subdiv = arrCircles

End Function