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)
![](https://lh3.googleusercontent.com/blogger_img_proxy/AEn0k_t0_fMlKzHGHGD3HJ6cgqm9ySuGGMHcKIsGXEUrATS8nQqfuba0YSu_Vwm29LB19KR3YXpTHJXexhpgZ-jMAFuSIPcrJWO7wnyDo8RciJQIwPAK8aGcmQVQbkDJ7cbsKr8T-7yNqiraYkGOhWckZw=s0-d)
Here is my first test on growing algorythm...
Highly inspired but for sure yet much less sophisticated...
L-system, fractals are now very trendy...
![](https://lh3.googleusercontent.com/blogger_img_proxy/AEn0k_tTn3llGjEW72jjnE_RMdLPL7VdbNTWcqDZx1bjdobKl_X-bN7mZBfY74s4tqiFe2tRv8dhUmGvK2-6hcWwyowjZ2PmMyAcJv_9-clG-B_OMAv6hzGn8oaoDnyV1IXcU-_XF8FFZFLRMQZUQEC55AVZSA=s0-d)
![](https://lh3.googleusercontent.com/blogger_img_proxy/AEn0k_sjTVZU7GeqVVAwLwEXtJK15UH0t09hTpTTQmsUA-3tp0Ub9lzBLnp2wzfjyzjaCS33rdc1mYbpTzSlslWpkLIV0lq1zIbcWW6VHtfFUz0x2KVRCgmcxtDd3pPlCinHpak1T3jfX1tAoxuoNam_BPg5lQ=s0-d)
![](https://lh3.googleusercontent.com/blogger_img_proxy/AEn0k_tID4VmiIj648gMrBchMNifS7T8T6_ce2m5yhuSRaF6q6EdUJuky1sK428VZsVD-cX8_7oE0twjKD2AxwgL0ZdURAt_JCtwfV7FjX8yBqNBjULBZ0CSWkfNib4_IfC6d24j2yzztLX_G_-rVyOIvE9_sL0=s0-d)
![](https://lh3.googleusercontent.com/blogger_img_proxy/AEn0k_tZrmA5BobPp5q0kafEM1feq3PQunytiG36R8oek2XGxo6lVorY_ft9jbW9xmJFnUjRnXC6fPCrBnzbQGgptEGB0MjzDI6tqh3xmZ-2RHkV6b2bFasoZNAm7HLIfcbIkUZCnKPcGXwp8RyJT6o3oWuQSw=s0-d)
![](https://lh3.googleusercontent.com/blogger_img_proxy/AEn0k_uGMsH_FIGpXWTYCpklVEBDLfd2uo1c9VoXq80mqj4_T2OALAlk_tbHu8i3gtp22Pd_gTgnghtTvOxFc-U335bOM5sUN5F03ZHYhb5VS7sTRkH0s7jyiA93YEeP3hY3CFZL70IOP9lsnjKEYNapimq6zg=s0-d)
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