Fractals (flora): Recursion, Substitution, L-systems
simple recursion
Recursion is the “[d]efining a program in such a way that it may call itself, so that use of the program may occur again and again during its execution.” (Arbib)
Here we create a function called add wiggle, that creates a series of lines as a wiggle from a single straight line input. The function can then be called on to replace the straight line sub-components of the wiggly line etc. etc. “This could go on forever” (processing error, presumably Ben Fry and Casey Reas).
koch curve
Option Explicit
'Script written for Pratt Advanced Computational Geometry seminar 2008
'Ezio Blasetti and Dave Pigram
Call Main()
Sub Main()
Dim strObject : strObject = Rhino.GetObject("give me a line to make wiggles out of", 4)
If IsNull(strObject) Then Exit Sub
Dim dblMinLength : dblMinLength = Rhino.GetReal("input the minimum length of the line", 0.1,0.0001)
If IsNull(dblMinLength) Then Exit Sub
Call addWiggle (strObject, dblMinLength)
End Sub
Function addWiggle (strLine,dblMinLength)
addWiggle = Null
If Rhino.CurveLength(strline) < dblMinLength Then Exit Function
'divide the line to 4 segments
Dim arrPoints : arrpoints = Rhino.DivideCurve(strLine,4)
'draw line from point 2 to 3
Dim strConstructLine : strConstructLine = Rhino.AddLine(arrPoints(2),arrPoints(3))
'rotate 90 degrees to the previous line
Call Rhino.RotateObject(strConstructLine,arrPoints(2),90,,VbFalse)
'get the end point of the construction curve
Dim arrEndPoint : arrEndPoint = Rhino.CurveEndPoint(strConstructLine)
'draw the new lines
Dim arrnewLines(3)
arrNewLines(0) = Rhino.AddLine(arrPoints(0),arrPoints(1))
arrNewLines(1) = Rhino.AddLine(arrPoints(1),arrEndPoint)
arrNewLines(2) = Rhino.AddLine(arrEndPoint,arrPoints(3))
arrNewLines(3) = Rhino.AddLine(arrPoints(3),arrPoints(4))
'clean up
Rhino.DeleteObject strLine
rhino.DeleteObject strConstructLine
'feed the new lines one of the time into the function
'loop through the new lines
Dim i, intCounter
For i = 0 To Ubound(arrNewLines)
Call addWiggle(arrnewLines(i),dblMinLength)
intCounter = intcounter +1
If intCounter = dblMinLength Then Exit Function
Next
'return the strings of all new lines
addwiggle = arrNewLines
End Function
'Script written for Pratt Advanced Computational Geometry seminar 2008
'Ezio Blasetti and Dave Pigram
Call Main()
Sub Main()
Dim strObject : strObject = Rhino.GetObject("give me a line to make wiggles out of", 4)
If IsNull(strObject) Then Exit Sub
Dim dblMinLength : dblMinLength = Rhino.GetReal("input the minimum length of the line", 0.1,0.0001)
If IsNull(dblMinLength) Then Exit Sub
Call addWiggle (strObject, dblMinLength)
End Sub
Function addWiggle (strLine,dblMinLength)
addWiggle = Null
If Rhino.CurveLength(strline) < dblMinLength Then Exit Function
'divide the line to 4 segments
Dim arrPoints : arrpoints = Rhino.DivideCurve(strLine,4)
'draw line from point 2 to 3
Dim strConstructLine : strConstructLine = Rhino.AddLine(arrPoints(2),arrPoints(3))
'rotate 90 degrees to the previous line
Call Rhino.RotateObject(strConstructLine,arrPoints(2),90,,VbFalse)
'get the end point of the construction curve
Dim arrEndPoint : arrEndPoint = Rhino.CurveEndPoint(strConstructLine)
'draw the new lines
Dim arrnewLines(3)
arrNewLines(0) = Rhino.AddLine(arrPoints(0),arrPoints(1))
arrNewLines(1) = Rhino.AddLine(arrPoints(1),arrEndPoint)
arrNewLines(2) = Rhino.AddLine(arrEndPoint,arrPoints(3))
arrNewLines(3) = Rhino.AddLine(arrPoints(3),arrPoints(4))
'clean up
Rhino.DeleteObject strLine
rhino.DeleteObject strConstructLine
'feed the new lines one of the time into the function
'loop through the new lines
Dim i, intCounter
For i = 0 To Ubound(arrNewLines)
Call addWiggle(arrnewLines(i),dblMinLength)
intCounter = intcounter +1
If intCounter = dblMinLength Then Exit Function
Next
'return the strings of all new lines
addwiggle = arrNewLines
End Function
recursive tree from rhinoscript 101
Option Explicit
'This script features an implementation of the recursive growth algorithm.
'A main subroutine was added (this one is missing from the primer, because
'it is very boring) to cater for the frontend.
'Comments have been added to this subroutine to explain the more exotic calls
'We initialize a set of variables that hold 'sticky' growth properties
'Since we declare these variables OUTSIDE of any procedure block, they will
'remain active after the script completes. This means the settings are remembered
'between script runs but they will be erased whenever Rhino exits.
'They all start out being uninitialized (not assigned any value)
Dim prop_MinTwigCount
Dim prop_MaxTwigCount
Dim prop_MaxGenerations
Dim prop_MaxTwigLength
Dim prop_LengthMutation
Dim prop_MaxTwigAngle
Dim prop_AngleMutation
Call PlantGenerator()
Sub PlantGenerator()
'Ask for a start point of the plant.
Dim ptRoot : ptRoot = Rhino.GetPoint("Root point for plant")
If IsNull(ptRoot) Then Exit Sub
'Check all global variables for initialization and assign default
'values if they have not yet been set. IsEmpty() can be used to
'detect uninitialized variables (as opposed to IsNull() which is
'used to detect faulty return values)
If IsEmpty(prop_MinTwigCount) Then prop_MinTwigCount = 1
If IsEmpty(prop_MaxTwigCount) Then prop_MaxTwigCount = 8
If IsEmpty(prop_MaxGenerations) Then prop_MaxGenerations = 5
If IsEmpty(prop_MaxTwigLength) Then prop_MaxTwigLength = 10.0
If IsEmpty(prop_LengthMutation) Then prop_LengthMutation = 0.75
If IsEmpty(prop_MaxTwigAngle) Then prop_MaxTwigAngle = 30.0
If IsEmpty(prop_AngleMutation) Then prop_AngleMutation = 0.85
'We'll be using a temporary variable to collect data from the user.
'We do this to prevent exposing the global variables to the frontend of Rhino
Dim local_Value
'Now collect all growth properties using a series of GetInteger and GetReal methods
'This could be done a lot cleaner using an iterated Option getter, but that's a lot
'more code. See chapter 8 on UI methods.
'Some of these values have limits on their value. See the RhinoScript help
'for information about the arguments.
local_Value = Rhino.GetInteger("Minimum twig count", prop_MinTwigCount)
If IsNull(local_Value) Then Exit Sub
prop_MinTwigCount = local_Value
local_Value = Rhino.GetInteger("Maximum twig count", prop_MaxTwigCount, 1)
If IsNull(local_Value) Then Exit Sub
prop_MaxTwigCount = local_Value
local_Value = Rhino.GetInteger("Maximum branch generations", prop_MaxGenerations, 1, 1000)
If IsNull(local_Value) Then Exit Sub
prop_MaxGenerations = local_Value
local_Value = Rhino.GetReal("Maximum twig length", prop_MaxTwigLength, 0.01)
If IsNull(local_Value) Then Exit Sub
prop_MaxTwigLength = local_Value
local_Value = Rhino.GetReal("Twig length mutation", prop_LengthMutation, 0.01)
If IsNull(local_Value) Then Exit Sub
prop_LengthMutation = local_Value
local_Value = Rhino.GetReal("Maximum twig angle", prop_MaxTwigAngle, 0.0, 90.0)
If IsNull(local_Value) Then Exit Sub
prop_MaxTwigAngle = local_Value
local_Value = Rhino.GetReal("Twig angle mutation", prop_AngleMutation, 0.01)
If IsNull(local_Value) Then Exit Sub
prop_AngleMutation = local_Value
'Assuming we made it this far (I.e. the user has not pressed Escape yet), randomize the
'vbScript engine. It's a good idea to use the Randomize() function to make sure that random
'sequences are not repeated.
Call Randomize()
'Turning of redraw will drastically speed up the tree generation. However, it's quite fun to watch
'so you might consider switching it off.
Call Rhino.EnableRedraw(False)
'Collect all tree-growth variables into a single array.
Dim GrowthProps
GrowthProps = Array(prop_MinTwigCount, prop_MaxTwigCount, prop_MaxGenerations, _
prop_MaxTwigLength, prop_LengthMutation, prop_MaxTwigAngle, prop_AngleMutation)
'Call the recursive function the first time. It will call itself from now on.
'We also need to tell this first function that is has generation 1
'We're assuming the growth direction at the root is vertical,
'so we have to supply a (0,0,1) direction vector.
Call RecursiveGrowth(ptRoot, Array(0,0,1), GrowthProps, 1)
'After all recursion has completed, be sure to enable the redraw again.
Call Rhino.EnableRedraw(True)
End Sub
'---------------------------------------------------------------------------------------
'-------------------------the code below appears in the primer--------------------------
'---------------------------------------------------------------------------------------
Sub RecursiveGrowth(ByVal ptStart, ByVal vecDir, ByVal Props(), ByVal Generation)
If Generation > Props(2) Then Exit Sub
Dim ptGrow, vecGrow, newTwig
'Copy and mutate the growth-properties
Dim newProps : newProps = Props
newProps(3) = Props(3) * Props(4)
newProps(5) = Props(5) * Props(6)
If newProps(5) > 90 Then newProps(5) = 90
'Determine the number of twigs (could be less than zero)
Dim N, maxN
maxN = CInt(Props(0) + Rnd() * (Props(1) - Props(0)))
For N = 1 To maxN
ptGrow = RandomPointInCone(ptStart, vecDir, 0.25*Props(3), Props(3), Props(5))
newTwig = AddArcDir(ptStart, ptGrow, vecDir)
If Not IsNull(newTwig) Then
vecGrow = Rhino.CurveTangent(newTwig, Rhino.CurveDomain(newTwig)(1))
Call RecursiveGrowth(ptGrow, vecGrow, newProps, Generation+1)
End If
Next
End Sub
Function RandomPointInCone(ByVal Origin, ByVal Direction, ByVal MinDistance, ByVal MaxDistance, ByVal MaxAngle)
Dim vecTwig
vecTwig = Rhino.VectorUnitize(Direction)
vecTwig = Rhino.VectorScale(vecTwig, MinDistance + Rnd() * (MaxDistance-MinDistance))
Dim MutationPlane
MutationPlane = Rhino.PlaneFromNormal(Array(0,0,0), vecTwig)
vecTwig = Rhino.VectorRotate(vecTwig, Rnd() * maxAngle, MutationPlane(1))
vecTwig = Rhino.VectorRotate(vecTwig, Rnd() * 360, Direction)
RandomPointInCone = Rhino.PointAdd(Origin, vecTwig)
End Function
Function AddArcDir(ByVal ptStart, ByVal ptEnd, ByVal vecDir)
AddArcDir = Null
Dim vecBase : vecBase = Rhino.PointSubtract(ptEnd, ptStart)
If Rhino.VectorLength(vecBase) = 0.0 Then Exit Function
If Rhino.IsVectorParallelTo(vecBase, vecDir) Then
AddArcDir = Rhino.AddLine(ptStart, ptEnd)
Exit Function
End If
vecBase = Rhino.VectorUnitize(vecBase)
vecDir = Rhino.VectorUnitize(vecDir)
Dim vecBisector : vecBisector = Rhino.VectorAdd(vecDir, vecBase)
vecBisector = Rhino.VectorUnitize(vecBisector)
Dim dotProd : dotProd = Rhino.VectorDotProduct(vecBisector, vecDir)
Dim midLength : midLength = (0.5 * Rhino.Distance(ptStart, ptEnd)) / dotProd
vecBisector = Rhino.VectorScale(vecBisector, midLength)
AddArcDir = Rhino.AddArc3Pt(ptStart, ptEnd, Rhino.PointAdd(ptStart, vecBisector))
End Function
'This script features an implementation of the recursive growth algorithm.
'A main subroutine was added (this one is missing from the primer, because
'it is very boring) to cater for the frontend.
'Comments have been added to this subroutine to explain the more exotic calls
'We initialize a set of variables that hold 'sticky' growth properties
'Since we declare these variables OUTSIDE of any procedure block, they will
'remain active after the script completes. This means the settings are remembered
'between script runs but they will be erased whenever Rhino exits.
'They all start out being uninitialized (not assigned any value)
Dim prop_MinTwigCount
Dim prop_MaxTwigCount
Dim prop_MaxGenerations
Dim prop_MaxTwigLength
Dim prop_LengthMutation
Dim prop_MaxTwigAngle
Dim prop_AngleMutation
Call PlantGenerator()
Sub PlantGenerator()
'Ask for a start point of the plant.
Dim ptRoot : ptRoot = Rhino.GetPoint("Root point for plant")
If IsNull(ptRoot) Then Exit Sub
'Check all global variables for initialization and assign default
'values if they have not yet been set. IsEmpty() can be used to
'detect uninitialized variables (as opposed to IsNull() which is
'used to detect faulty return values)
If IsEmpty(prop_MinTwigCount) Then prop_MinTwigCount = 1
If IsEmpty(prop_MaxTwigCount) Then prop_MaxTwigCount = 8
If IsEmpty(prop_MaxGenerations) Then prop_MaxGenerations = 5
If IsEmpty(prop_MaxTwigLength) Then prop_MaxTwigLength = 10.0
If IsEmpty(prop_LengthMutation) Then prop_LengthMutation = 0.75
If IsEmpty(prop_MaxTwigAngle) Then prop_MaxTwigAngle = 30.0
If IsEmpty(prop_AngleMutation) Then prop_AngleMutation = 0.85
'We'll be using a temporary variable to collect data from the user.
'We do this to prevent exposing the global variables to the frontend of Rhino
Dim local_Value
'Now collect all growth properties using a series of GetInteger and GetReal methods
'This could be done a lot cleaner using an iterated Option getter, but that's a lot
'more code. See chapter 8 on UI methods.
'Some of these values have limits on their value. See the RhinoScript help
'for information about the arguments.
local_Value = Rhino.GetInteger("Minimum twig count", prop_MinTwigCount)
If IsNull(local_Value) Then Exit Sub
prop_MinTwigCount = local_Value
local_Value = Rhino.GetInteger("Maximum twig count", prop_MaxTwigCount, 1)
If IsNull(local_Value) Then Exit Sub
prop_MaxTwigCount = local_Value
local_Value = Rhino.GetInteger("Maximum branch generations", prop_MaxGenerations, 1, 1000)
If IsNull(local_Value) Then Exit Sub
prop_MaxGenerations = local_Value
local_Value = Rhino.GetReal("Maximum twig length", prop_MaxTwigLength, 0.01)
If IsNull(local_Value) Then Exit Sub
prop_MaxTwigLength = local_Value
local_Value = Rhino.GetReal("Twig length mutation", prop_LengthMutation, 0.01)
If IsNull(local_Value) Then Exit Sub
prop_LengthMutation = local_Value
local_Value = Rhino.GetReal("Maximum twig angle", prop_MaxTwigAngle, 0.0, 90.0)
If IsNull(local_Value) Then Exit Sub
prop_MaxTwigAngle = local_Value
local_Value = Rhino.GetReal("Twig angle mutation", prop_AngleMutation, 0.01)
If IsNull(local_Value) Then Exit Sub
prop_AngleMutation = local_Value
'Assuming we made it this far (I.e. the user has not pressed Escape yet), randomize the
'vbScript engine. It's a good idea to use the Randomize() function to make sure that random
'sequences are not repeated.
Call Randomize()
'Turning of redraw will drastically speed up the tree generation. However, it's quite fun to watch
'so you might consider switching it off.
Call Rhino.EnableRedraw(False)
'Collect all tree-growth variables into a single array.
Dim GrowthProps
GrowthProps = Array(prop_MinTwigCount, prop_MaxTwigCount, prop_MaxGenerations, _
prop_MaxTwigLength, prop_LengthMutation, prop_MaxTwigAngle, prop_AngleMutation)
'Call the recursive function the first time. It will call itself from now on.
'We also need to tell this first function that is has generation 1
'We're assuming the growth direction at the root is vertical,
'so we have to supply a (0,0,1) direction vector.
Call RecursiveGrowth(ptRoot, Array(0,0,1), GrowthProps, 1)
'After all recursion has completed, be sure to enable the redraw again.
Call Rhino.EnableRedraw(True)
End Sub
'---------------------------------------------------------------------------------------
'-------------------------the code below appears in the primer--------------------------
'---------------------------------------------------------------------------------------
Sub RecursiveGrowth(ByVal ptStart, ByVal vecDir, ByVal Props(), ByVal Generation)
If Generation > Props(2) Then Exit Sub
Dim ptGrow, vecGrow, newTwig
'Copy and mutate the growth-properties
Dim newProps : newProps = Props
newProps(3) = Props(3) * Props(4)
newProps(5) = Props(5) * Props(6)
If newProps(5) > 90 Then newProps(5) = 90
'Determine the number of twigs (could be less than zero)
Dim N, maxN
maxN = CInt(Props(0) + Rnd() * (Props(1) - Props(0)))
For N = 1 To maxN
ptGrow = RandomPointInCone(ptStart, vecDir, 0.25*Props(3), Props(3), Props(5))
newTwig = AddArcDir(ptStart, ptGrow, vecDir)
If Not IsNull(newTwig) Then
vecGrow = Rhino.CurveTangent(newTwig, Rhino.CurveDomain(newTwig)(1))
Call RecursiveGrowth(ptGrow, vecGrow, newProps, Generation+1)
End If
Next
End Sub
Function RandomPointInCone(ByVal Origin, ByVal Direction, ByVal MinDistance, ByVal MaxDistance, ByVal MaxAngle)
Dim vecTwig
vecTwig = Rhino.VectorUnitize(Direction)
vecTwig = Rhino.VectorScale(vecTwig, MinDistance + Rnd() * (MaxDistance-MinDistance))
Dim MutationPlane
MutationPlane = Rhino.PlaneFromNormal(Array(0,0,0), vecTwig)
vecTwig = Rhino.VectorRotate(vecTwig, Rnd() * maxAngle, MutationPlane(1))
vecTwig = Rhino.VectorRotate(vecTwig, Rnd() * 360, Direction)
RandomPointInCone = Rhino.PointAdd(Origin, vecTwig)
End Function
Function AddArcDir(ByVal ptStart, ByVal ptEnd, ByVal vecDir)
AddArcDir = Null
Dim vecBase : vecBase = Rhino.PointSubtract(ptEnd, ptStart)
If Rhino.VectorLength(vecBase) = 0.0 Then Exit Function
If Rhino.IsVectorParallelTo(vecBase, vecDir) Then
AddArcDir = Rhino.AddLine(ptStart, ptEnd)
Exit Function
End If
vecBase = Rhino.VectorUnitize(vecBase)
vecDir = Rhino.VectorUnitize(vecDir)
Dim vecBisector : vecBisector = Rhino.VectorAdd(vecDir, vecBase)
vecBisector = Rhino.VectorUnitize(vecBisector)
Dim dotProd : dotProd = Rhino.VectorDotProduct(vecBisector, vecDir)
Dim midLength : midLength = (0.5 * Rhino.Distance(ptStart, ptEnd)) / dotProd
vecBisector = Rhino.VectorScale(vecBisector, midLength)
AddArcDir = Rhino.AddArc3Pt(ptStart, ptEnd, Rhino.PointAdd(ptStart, vecBisector))
End Function
l-systems
lsystem definition from wikipedia
An L-system or Lindenmayer system is a parallel rewriting system, namely a variant of a formal grammar (a set of rules and symbols), most famously used to model the growth processes of plant development, but also able to model the morphology of a variety of organisms.[1] L-systems can also be used to generate self-similar fractals such as iterated function systems. L-systems were introduced and developed in 1968 by the Hungarian theoretical biologist and botanist from the University of Utrecht, Aristid Lindenmayer (1925–1989).
simple lsystem data structure
Option Explicit
Call Main()
Sub Main()
'set initial state
Dim strGeneration : strGeneration = "A"
Call makeDots(strGeneration, -1)
'loop through generations
Dim i
For i = 0 To 15
'print the current contents of the generation
Rhino.print "generation " & i & ": " & strGeneration
'enact the substitution rules
strGeneration = ApplyRules(strGeneration)
Call makeDots(strGeneration, i)
Next
Rhino.print "generation " & i & ": " & strGeneration
End Sub
Function ApplyRules(strGen)
strGen = Replace(strGen, "C_A", "0")
strGen = Replace(strGen, "A", "1")
strGen = Replace(strGen, "B", "2")
strGen = Replace(strGen, "C", "3")
strGen = Replace(strGen, "0", "C")
strGen = Replace(strGen, "1", "B")
strGen = Replace(strGen, "2", "C")
strGen = Replace(strGen, "3", "A_B")
ApplyRules = strGen
End Function
Sub makeDots(strText, intCurrentGen)
Dim i, arrTokens
arrTokens = Rhino.Strtok(strText,"_")
For i = 0 To Ubound(arrTokens)
Call Rhino.AddTextDot (arrTokens(i), array(i,intCurrentGen))
Next
End Sub
Call Main()
Sub Main()
'set initial state
Dim strGeneration : strGeneration = "A"
Call makeDots(strGeneration, -1)
'loop through generations
Dim i
For i = 0 To 15
'print the current contents of the generation
Rhino.print "generation " & i & ": " & strGeneration
'enact the substitution rules
strGeneration = ApplyRules(strGeneration)
Call makeDots(strGeneration, i)
Next
Rhino.print "generation " & i & ": " & strGeneration
End Sub
Function ApplyRules(strGen)
strGen = Replace(strGen, "C_A", "0")
strGen = Replace(strGen, "A", "1")
strGen = Replace(strGen, "B", "2")
strGen = Replace(strGen, "C", "3")
strGen = Replace(strGen, "0", "C")
strGen = Replace(strGen, "1", "B")
strGen = Replace(strGen, "2", "C")
strGen = Replace(strGen, "3", "A_B")
ApplyRules = strGen
End Function
Sub makeDots(strText, intCurrentGen)
Dim i, arrTokens
arrTokens = Rhino.Strtok(strText,"_")
For i = 0 To Ubound(arrTokens)
Call Rhino.AddTextDot (arrTokens(i), array(i,intCurrentGen))
Next
End Sub
simple lsystem data driving cubes
Option Explicit
Call Main()
Sub Main()
'set initial state
Dim strGeneration : strGeneration = "A"
Call makeDots(strGeneration, -1)
'loop through generations
Dim i
For i = 0 To 15
'print the current contents of the generation
Rhino.print "generation " & i & ": " & strGeneration
'enact the substitution rules
strGeneration = ApplyRules(strGeneration)
Call makeDots(strGeneration, i)
Next
Rhino.print "generation " & i & ": " & strGeneration
End Sub
Function ApplyRules(strGen)
strGen = Replace(strGen, "C_A", "0")
strGen = Replace(strGen, "A", "1")
strGen = Replace(strGen, "B", "2")
strGen = Replace(strGen, "C", "3")
strGen = Replace(strGen, "0", "C")
strGen = Replace(strGen, "1", "B")
strGen = Replace(strGen, "2", "C")
strGen = Replace(strGen, "3", "A_B")
ApplyRules = strGen
End Function
Sub makeDots(strText, intCurrentGen)
Dim i, arrTokens
arrTokens = Rhino.Strtok(strText,"_")
For i = 0 To Ubound(arrTokens)
If arrTokens(i)="A" Then
Rhino.AddBox(array(array(i,intCurrentGen,0),array(i+1,intCurrentGen,0),array(i+1,intCurrentGen+1,0),array(i,intCurrentGen+1,0),_
array(i,intCurrentGen,1),array(i+1,intCurrentGen,1),array(i+1,intCurrentGen+1,1),array(i,intCurrentGen+1,1)))
ElseIf arrTokens(i)="B" Then
Rhino.AddBox(array(array(i,intCurrentGen,0),array(i+1,intCurrentGen,0),array(i+1,intCurrentGen+1,0),array(i,intCurrentGen+1,0),_
array(i,intCurrentGen,2),array(i+1,intCurrentGen,2),array(i+1,intCurrentGen+1,2),array(i,intCurrentGen+1,2)))
ElseIf arrTokens(i)="C" Then
Rhino.AddBox(array(array(i,intCurrentGen,0),array(i+1,intCurrentGen,0),array(i+1,intCurrentGen+1,0),array(i,intCurrentGen+1,0),_
array(i,intCurrentGen,3),array(i+1,intCurrentGen,3),array(i+1,intCurrentGen+1,3),array(i,intCurrentGen+1,3)))
End If
Next
End Sub
Call Main()
Sub Main()
'set initial state
Dim strGeneration : strGeneration = "A"
Call makeDots(strGeneration, -1)
'loop through generations
Dim i
For i = 0 To 15
'print the current contents of the generation
Rhino.print "generation " & i & ": " & strGeneration
'enact the substitution rules
strGeneration = ApplyRules(strGeneration)
Call makeDots(strGeneration, i)
Next
Rhino.print "generation " & i & ": " & strGeneration
End Sub
Function ApplyRules(strGen)
strGen = Replace(strGen, "C_A", "0")
strGen = Replace(strGen, "A", "1")
strGen = Replace(strGen, "B", "2")
strGen = Replace(strGen, "C", "3")
strGen = Replace(strGen, "0", "C")
strGen = Replace(strGen, "1", "B")
strGen = Replace(strGen, "2", "C")
strGen = Replace(strGen, "3", "A_B")
ApplyRules = strGen
End Function
Sub makeDots(strText, intCurrentGen)
Dim i, arrTokens
arrTokens = Rhino.Strtok(strText,"_")
For i = 0 To Ubound(arrTokens)
If arrTokens(i)="A" Then
Rhino.AddBox(array(array(i,intCurrentGen,0),array(i+1,intCurrentGen,0),array(i+1,intCurrentGen+1,0),array(i,intCurrentGen+1,0),_
array(i,intCurrentGen,1),array(i+1,intCurrentGen,1),array(i+1,intCurrentGen+1,1),array(i,intCurrentGen+1,1)))
ElseIf arrTokens(i)="B" Then
Rhino.AddBox(array(array(i,intCurrentGen,0),array(i+1,intCurrentGen,0),array(i+1,intCurrentGen+1,0),array(i,intCurrentGen+1,0),_
array(i,intCurrentGen,2),array(i+1,intCurrentGen,2),array(i+1,intCurrentGen+1,2),array(i,intCurrentGen+1,2)))
ElseIf arrTokens(i)="C" Then
Rhino.AddBox(array(array(i,intCurrentGen,0),array(i+1,intCurrentGen,0),array(i+1,intCurrentGen+1,0),array(i,intCurrentGen+1,0),_
array(i,intCurrentGen,3),array(i+1,intCurrentGen,3),array(i+1,intCurrentGen+1,3),array(i,intCurrentGen+1,3)))
End If
Next
End Sub
lsystem diagram with interface for rule input
download compiled plugin with installation instuctions
Option Explicit
'Script written by Ezio Blasetti
'Some custom functions belong to earlier script by Dave Pigram
'Script version Sunday, February 08, 2009 8:36:45 PM
Call Setup()
Sub Setup()
Dim intNumberRules : intNumberRules = Rhino.GetInteger("Input the number of rules", 4, 2)
Dim intGenerations : intGenerations = Rhino.GetInteger("how many generations", 10, 3)
Dim dblDistance : dblDistance = Rhino.GetReal("total width of the diagram",10)
Dim strGeneration : strGeneration = Rhino.StringBox("use CAPS for letters and space for delimiters","A B", "Initial Generation Input")
Dim arrRuleStrings : arrRuleStrings = getRules(intNumberRules)
Dim arrblnDrawTree : arrblnDrawTree = Rhino.GetBoolean("add the tree diagram", array("drawTree","No","Yes"),array(True))
Dim arrStartStrings : arrStartStrings = arrRuleStrings(0)
Dim arrSubstituteStrings : arrSubstituteStrings = arrRuleStrings(1)
Dim arrTokens : arrTokens = Rhino.Strtok(strGeneration)
Dim minX : minX = 0
Dim maxX : maxX = dblDistance
Dim dblSpacing : dblSpacing = (maxX-minX)/(Ubound(arrTokens)+1)
Dim arrCharacters : arrCharacters = CullDuplicateStrFrom3Arrays(arrTokens, arrStartStrings, arrSubstituteStrings)
'Dim arrCharacters : arrCharacters = array("A","B","C","D")
Call Rhino.AddLayer("0")
Call Rhino.EnableRedraw(vbFalse)
Dim i, j
For i=0 To Ubound(arrTokens)
maxX = minX + dblSpacing
Dim strPlane : strPlane = Rhino.AddSrfPt (array(array(minX,0,0),array(maxX,0,0),array(maxX,-1,0),array(minX,-1,0)))
'Dim strPlane : strPlane = Rhino.AddSrfPt (array(array(i,0,0),array(i+1,0,0),array(i+1,-1,0),array(i,-1,0)))
minX = maxX
Call Rhino.ObjectName(strPlane, Ucase(arrTokens(i)))
Call Rhino.ObjectLayer(strPlane, "0")
For j=0 To Ubound(arrCharacters)
If arrTokens(i)=arrCharacters(j) Then
Dim intColorValue : intColorValue = j*(255/Ubound(arrCharacters))
Call Rhino.ObjectColor(strPlane, RGB(intColorValue+30,0,intColorValue+30))
End If
Next
Next
Call Rhino.EnableRedraw(vbTrue)
For i=1 To intGenerations
Call Rhino.EnableRedraw(vbFalse)
Call Main(i, arrStartStrings, arrSubstituteStrings, arrCharacters, arrblnDrawTree(0))
Call Rhino.EnableRedraw(vbTrue)
Next
Call cleanUpLayers(arrCharacters, intGenerations)
Rhino.Print "thanks for playing with me..."
End Sub
Sub Main(intGen, arrStartStrings, arrSubstituteStrings, arrCharacters, blnDrawTree)
Dim arrParents : arrParents = Rhino.ObjectsByLayer(CStr(intGen-1))
arrParents = reverseArrayOrder(arrParents)
Call Rhino.AddLayer(intGen)
If blnDrawTree Then
Call Rhino.AddLayer("TreeLines")
End If
Dim i
For i=0 To Ubound(arrParents)
Dim strParent : strParent = arrParents(i)
Dim strParentName : strParentName = Rhino.ObjectName (strParent)
Dim arrParentPts : arrParentPts = Rhino.SurfacePoints(strParent)
Dim k : k=0
Do While k <= Ubound(arrStartStrings) 'Ubound(arrStartStrings) is equal to intNumberRules -1 ie loop through each rule
Dim arrRuleTokens : arrRuleTokens = Rhino.Strtok(arrStartStrings(k))
'skip the check if there are not enough letters left in the generation to match the current start string
If Not i + Ubound(arrRuleTokens) > Ubound(arrParents) Then
'reset the variable that holds the string to be compared to the current startString
Dim strToCompare : strToCompare = Null
'create a single string that is the same length as the current rule start string with underscores seperating each letter.
Dim j
For j = 0 To Ubound(arrRuleTokens)
strToCompare = addString2String(strToCompare, Rhino.ObjectName(arrParents(i+j))," ")
Next ' end ruleTokens loop
'compare to the rule and if it matches, make the substitution
'print "k is: " & k
If arrStartStrings(k) = strToCompare Then
Dim arrTokens : arrTokens = Rhino.Strtok(arrSubstituteStrings(k))
Dim arrParentUboundPt : arrParentUboundPt = Rhino.SurfacePoints(arrParents(i+Ubound(arrRuleTokens)))
Dim minX : minX = arrParentPts(0)(0)
Dim maxX : maxX = arrParentUboundPt(2)(0)
Dim dblSpacing : dblSpacing = (maxX-minX)/(Ubound(arrTokens)+1)
Dim e
For e=0 To Ubound(arrTokens)
'print "minX is:" & minX & " maxX is :" & maxX
maxX = minX + dblSpacing
'add the substitution string To the Next generation
Dim strPlane : strPlane = Rhino.AddSrfPt (array(array(minX,-intGen-1,0),array(maxX,-intGen-1,0),array(maxX,-intGen,0),array(minX,-intGen,0)))
If blnDrawTree Then
Dim p
For p=0 To Ubound(arrRuleTokens)
Dim strLine : strLine = rhino.addline(Rhino.SurfaceAreaCentroid(arrParents(i+p))(0),Rhino.SurfaceAreaCentroid(strPlane)(0))
Call Rhino.ObjectLayer(strLine,"TreeLines")
Next
End If
minX = maxX
'print arrTokens(e)
Call Rhino.ObjectName(strPlane, Ucase(arrTokens(e)))
Call Rhino.ObjectLayer(strPlane, intGen)
Dim l
For l=0 To Ubound(arrCharacters)
If arrTokens(e)=arrCharacters(l) Then
Dim intColorValue : intColorValue = l*(255/Ubound(arrCharacters))
Call Rhino.ObjectColor(strPlane, RGB(intColorValue+30,0,intColorValue+30))
End If
Next
Next
'finish this k-loop
k = Ubound(arrStartStrings)
'skip ahead to the next unused letter in this generation, before checking against the first start string
i = i + Ubound(arrRuleTokens)
End If
End If
'progress counter
k = k + 1
Loop 'arrStartStrings loop
Next
End Sub
Function CullDuplicateStrFrom3Arrays(arr0, arr1, arr2)
CullDuplicateStrFrom3Arrays = Null
If Not IsArray(arr0) Then Exit Function
If Not IsArray(arr1) Then Exit Function
If Not IsArray(arr2) Then Exit Function
'arr0 = Rhino.CullDuplicateStrings(arr0)
'arr1 = Rhino.CullDuplicateStrings(arr1)
'arr2 = Rhino.CullDuplicateStrings(arr2)
ReDim arrDifferentChars(0)
Dim arrTokens, i, j, k, bln, blnTemp
Dim str
For i=0 To Ubound(arr0)
str = arr0(i)
If i=0 Then
arrDifferentChars(0) = str
End If
arrTokens = Rhino.Strtok(str)
For j=0 To Ubound(arrTokens)
bln = VbFalse
For k=0 To Ubound(arrDifferentChars)
If arrTokens(j) = arrDifferentChars(k) Then
blnTemp = vbTrue
Else
blnTemp = vbFalse
End If
bln = bln Or blnTemp
Next
If bln = vbFalse Then
ReDim Preserve arrDifferentChars(Ubound(arrDifferentChars)+1)
arrDifferentChars(Ubound(arrDifferentChars)) = arrTokens(j)
End If
Next
Next
For i=0 To Ubound(arr1)
str = arr1(i)
arrTokens = Rhino.Strtok(str)
For j=0 To Ubound(arrTokens)
bln = VbFalse
For k=0 To Ubound(arrDifferentChars)
If arrTokens(j) = arrDifferentChars(k) Then
blnTemp = vbTrue
Else
blnTemp = vbFalse
End If
bln = bln Or blnTemp
Next
If bln = vbFalse Then
ReDim Preserve arrDifferentChars(Ubound(arrDifferentChars)+1)
arrDifferentChars(Ubound(arrDifferentChars)) = arrTokens(j)
End If
Next
Next
For i=0 To Ubound(arr2)
str = arr2(i)
arrTokens = Rhino.Strtok(str)
For j=0 To Ubound(arrTokens)
bln = VbFalse
For k=0 To Ubound(arrDifferentChars)
If arrTokens(j) = arrDifferentChars(k) Then
blnTemp = vbTrue
Else
blnTemp = vbFalse
End If
bln = bln Or blnTemp
Next
If bln = vbFalse Then
ReDim Preserve arrDifferentChars(Ubound(arrDifferentChars)+1)
arrDifferentChars(Ubound(arrDifferentChars)) = arrTokens(j)
End If
Next
Next
CullDuplicateStrFrom3Arrays = arrDifferentChars
End Function
Function addString2String(strOriginalString, strStringToAdd, strSpacer)
addString2String = Null
Dim strNew
If IsNull(strOriginalString) Then
strNew = strStringToAdd
Else
strNew = strOriginalString & strSpacer & strStringToAdd
End If
addString2String = strNew
End Function
Function reverseArrayOrder(arr)
reverseArrayOrder = Null
If Not IsArray(arr) Then Exit Function
Dim arrReturn : arrReturn = arr
Dim i
Dim count : count = Ubound(arr)
For i=0 To Ubound(arr)
arrReturn(i) = arr(count)
count= count - 1
Next
reverseArrayOrder = arrReturn
End Function
Function getRules(intNumberRules)
getRules = Null
Dim i, arrRulePrompts(), arrDefaultStarts(), arrDefaultSubs(), arrStartStrings, arrSubstituteStrings
ReDim arrRulePrompts (intNumberRules - 1)
ReDim arrDefaultStarts (intNumberRules - 1)
ReDim arrDefaultSubs (intNumberRules - 1)
'create arrays of strings to populate the Property List Boxes
For i = 0 To intNumberRules - 1
arrRulePrompts (i) = "Rule " & i & " Start String:"
'get the previously used rules from a file
arrDefaultStarts(i) = Rhino.GetSettings(Rhino.InstallFolder & "Lsystem.ini", "L-System", "DefaultStarts_" & i)
arrDefaultSubs (i) = Rhino.GetSettings(Rhino.InstallFolder & "Lsystem.ini", "L-System", "DefaultSubs_" & i)
If IsNull(arrDefaultStarts (i)) Then arrDefaultStarts (i) = "X_X..."
If IsNull(arrDefaultSubs (i)) Then arrDefaultSubs (i) = "X_X..."
Next
'prompt for the user to input the rules in two phases: first the strings that will be replaced - this will be in heirarchial order ie first rule will be enacted first
'longer strings (clauses) should be entered first.
'In the second phase the leters that will be substituted For the starting strings are entered underscores ("_") must seperate Each letter
arrStartStrings = Rhino.PropertyListBox (arrRulePrompts, arrDefaultStarts, "use CAPS for letters and space for delimiters", "L-System Rules: Start Strings")
arrSubstituteStrings = Rhino.PropertyListBox (arrStartStrings, arrDefaultSubs, "use CAPS for letters and space for delimiters", "L-System Rules: Substitute Strings")
For i = 0 To intNumberRules - 1
'write these rules to a file so that you don't have to re-enter them next time
Rhino.SaveSettings Rhino.InstallFolder & "Lsystem.ini", "L-System", "DefaultStarts_" & i, arrStartStrings(i)
Rhino.SaveSettings Rhino.InstallFolder & "Lsystem.ini", "L-System", "DefaultSubs_" & i, arrSubstituteStrings(i)
Next
getRules = array(arrStartStrings,arrSubstituteStrings)
End Function
Sub cleanUpLayers(arrCharacters, intGenerations)
Dim strCharacter
Call Rhino.EnableRedraw (vbFalse)
For Each strCharacter In arrCharacters
Call Rhino.AddLayer(strCharacter)
Dim arrObjects : arrObjects = Rhino.ObjectsByName(Ucase(strCharacter))
If Not IsNull(arrObjects) Then
Dim strObject
For Each strObject In arrObjects
Call Rhino.ObjectLayer(strObject, strCharacter)
Next
End If
Next
Dim i
For i=0 To intGenerations
Rhino.DeleteLayer(i)
Next
Call Rhino.EnableRedraw (vbTrue)
End Sub
'Script written by Ezio Blasetti
'Some custom functions belong to earlier script by Dave Pigram
'Script version Sunday, February 08, 2009 8:36:45 PM
Call Setup()
Sub Setup()
Dim intNumberRules : intNumberRules = Rhino.GetInteger("Input the number of rules", 4, 2)
Dim intGenerations : intGenerations = Rhino.GetInteger("how many generations", 10, 3)
Dim dblDistance : dblDistance = Rhino.GetReal("total width of the diagram",10)
Dim strGeneration : strGeneration = Rhino.StringBox("use CAPS for letters and space for delimiters","A B", "Initial Generation Input")
Dim arrRuleStrings : arrRuleStrings = getRules(intNumberRules)
Dim arrblnDrawTree : arrblnDrawTree = Rhino.GetBoolean("add the tree diagram", array("drawTree","No","Yes"),array(True))
Dim arrStartStrings : arrStartStrings = arrRuleStrings(0)
Dim arrSubstituteStrings : arrSubstituteStrings = arrRuleStrings(1)
Dim arrTokens : arrTokens = Rhino.Strtok(strGeneration)
Dim minX : minX = 0
Dim maxX : maxX = dblDistance
Dim dblSpacing : dblSpacing = (maxX-minX)/(Ubound(arrTokens)+1)
Dim arrCharacters : arrCharacters = CullDuplicateStrFrom3Arrays(arrTokens, arrStartStrings, arrSubstituteStrings)
'Dim arrCharacters : arrCharacters = array("A","B","C","D")
Call Rhino.AddLayer("0")
Call Rhino.EnableRedraw(vbFalse)
Dim i, j
For i=0 To Ubound(arrTokens)
maxX = minX + dblSpacing
Dim strPlane : strPlane = Rhino.AddSrfPt (array(array(minX,0,0),array(maxX,0,0),array(maxX,-1,0),array(minX,-1,0)))
'Dim strPlane : strPlane = Rhino.AddSrfPt (array(array(i,0,0),array(i+1,0,0),array(i+1,-1,0),array(i,-1,0)))
minX = maxX
Call Rhino.ObjectName(strPlane, Ucase(arrTokens(i)))
Call Rhino.ObjectLayer(strPlane, "0")
For j=0 To Ubound(arrCharacters)
If arrTokens(i)=arrCharacters(j) Then
Dim intColorValue : intColorValue = j*(255/Ubound(arrCharacters))
Call Rhino.ObjectColor(strPlane, RGB(intColorValue+30,0,intColorValue+30))
End If
Next
Next
Call Rhino.EnableRedraw(vbTrue)
For i=1 To intGenerations
Call Rhino.EnableRedraw(vbFalse)
Call Main(i, arrStartStrings, arrSubstituteStrings, arrCharacters, arrblnDrawTree(0))
Call Rhino.EnableRedraw(vbTrue)
Next
Call cleanUpLayers(arrCharacters, intGenerations)
Rhino.Print "thanks for playing with me..."
End Sub
Sub Main(intGen, arrStartStrings, arrSubstituteStrings, arrCharacters, blnDrawTree)
Dim arrParents : arrParents = Rhino.ObjectsByLayer(CStr(intGen-1))
arrParents = reverseArrayOrder(arrParents)
Call Rhino.AddLayer(intGen)
If blnDrawTree Then
Call Rhino.AddLayer("TreeLines")
End If
Dim i
For i=0 To Ubound(arrParents)
Dim strParent : strParent = arrParents(i)
Dim strParentName : strParentName = Rhino.ObjectName (strParent)
Dim arrParentPts : arrParentPts = Rhino.SurfacePoints(strParent)
Dim k : k=0
Do While k <= Ubound(arrStartStrings) 'Ubound(arrStartStrings) is equal to intNumberRules -1 ie loop through each rule
Dim arrRuleTokens : arrRuleTokens = Rhino.Strtok(arrStartStrings(k))
'skip the check if there are not enough letters left in the generation to match the current start string
If Not i + Ubound(arrRuleTokens) > Ubound(arrParents) Then
'reset the variable that holds the string to be compared to the current startString
Dim strToCompare : strToCompare = Null
'create a single string that is the same length as the current rule start string with underscores seperating each letter.
Dim j
For j = 0 To Ubound(arrRuleTokens)
strToCompare = addString2String(strToCompare, Rhino.ObjectName(arrParents(i+j))," ")
Next ' end ruleTokens loop
'compare to the rule and if it matches, make the substitution
'print "k is: " & k
If arrStartStrings(k) = strToCompare Then
Dim arrTokens : arrTokens = Rhino.Strtok(arrSubstituteStrings(k))
Dim arrParentUboundPt : arrParentUboundPt = Rhino.SurfacePoints(arrParents(i+Ubound(arrRuleTokens)))
Dim minX : minX = arrParentPts(0)(0)
Dim maxX : maxX = arrParentUboundPt(2)(0)
Dim dblSpacing : dblSpacing = (maxX-minX)/(Ubound(arrTokens)+1)
Dim e
For e=0 To Ubound(arrTokens)
'print "minX is:" & minX & " maxX is :" & maxX
maxX = minX + dblSpacing
'add the substitution string To the Next generation
Dim strPlane : strPlane = Rhino.AddSrfPt (array(array(minX,-intGen-1,0),array(maxX,-intGen-1,0),array(maxX,-intGen,0),array(minX,-intGen,0)))
If blnDrawTree Then
Dim p
For p=0 To Ubound(arrRuleTokens)
Dim strLine : strLine = rhino.addline(Rhino.SurfaceAreaCentroid(arrParents(i+p))(0),Rhino.SurfaceAreaCentroid(strPlane)(0))
Call Rhino.ObjectLayer(strLine,"TreeLines")
Next
End If
minX = maxX
'print arrTokens(e)
Call Rhino.ObjectName(strPlane, Ucase(arrTokens(e)))
Call Rhino.ObjectLayer(strPlane, intGen)
Dim l
For l=0 To Ubound(arrCharacters)
If arrTokens(e)=arrCharacters(l) Then
Dim intColorValue : intColorValue = l*(255/Ubound(arrCharacters))
Call Rhino.ObjectColor(strPlane, RGB(intColorValue+30,0,intColorValue+30))
End If
Next
Next
'finish this k-loop
k = Ubound(arrStartStrings)
'skip ahead to the next unused letter in this generation, before checking against the first start string
i = i + Ubound(arrRuleTokens)
End If
End If
'progress counter
k = k + 1
Loop 'arrStartStrings loop
Next
End Sub
Function CullDuplicateStrFrom3Arrays(arr0, arr1, arr2)
CullDuplicateStrFrom3Arrays = Null
If Not IsArray(arr0) Then Exit Function
If Not IsArray(arr1) Then Exit Function
If Not IsArray(arr2) Then Exit Function
'arr0 = Rhino.CullDuplicateStrings(arr0)
'arr1 = Rhino.CullDuplicateStrings(arr1)
'arr2 = Rhino.CullDuplicateStrings(arr2)
ReDim arrDifferentChars(0)
Dim arrTokens, i, j, k, bln, blnTemp
Dim str
For i=0 To Ubound(arr0)
str = arr0(i)
If i=0 Then
arrDifferentChars(0) = str
End If
arrTokens = Rhino.Strtok(str)
For j=0 To Ubound(arrTokens)
bln = VbFalse
For k=0 To Ubound(arrDifferentChars)
If arrTokens(j) = arrDifferentChars(k) Then
blnTemp = vbTrue
Else
blnTemp = vbFalse
End If
bln = bln Or blnTemp
Next
If bln = vbFalse Then
ReDim Preserve arrDifferentChars(Ubound(arrDifferentChars)+1)
arrDifferentChars(Ubound(arrDifferentChars)) = arrTokens(j)
End If
Next
Next
For i=0 To Ubound(arr1)
str = arr1(i)
arrTokens = Rhino.Strtok(str)
For j=0 To Ubound(arrTokens)
bln = VbFalse
For k=0 To Ubound(arrDifferentChars)
If arrTokens(j) = arrDifferentChars(k) Then
blnTemp = vbTrue
Else
blnTemp = vbFalse
End If
bln = bln Or blnTemp
Next
If bln = vbFalse Then
ReDim Preserve arrDifferentChars(Ubound(arrDifferentChars)+1)
arrDifferentChars(Ubound(arrDifferentChars)) = arrTokens(j)
End If
Next
Next
For i=0 To Ubound(arr2)
str = arr2(i)
arrTokens = Rhino.Strtok(str)
For j=0 To Ubound(arrTokens)
bln = VbFalse
For k=0 To Ubound(arrDifferentChars)
If arrTokens(j) = arrDifferentChars(k) Then
blnTemp = vbTrue
Else
blnTemp = vbFalse
End If
bln = bln Or blnTemp
Next
If bln = vbFalse Then
ReDim Preserve arrDifferentChars(Ubound(arrDifferentChars)+1)
arrDifferentChars(Ubound(arrDifferentChars)) = arrTokens(j)
End If
Next
Next
CullDuplicateStrFrom3Arrays = arrDifferentChars
End Function
Function addString2String(strOriginalString, strStringToAdd, strSpacer)
addString2String = Null
Dim strNew
If IsNull(strOriginalString) Then
strNew = strStringToAdd
Else
strNew = strOriginalString & strSpacer & strStringToAdd
End If
addString2String = strNew
End Function
Function reverseArrayOrder(arr)
reverseArrayOrder = Null
If Not IsArray(arr) Then Exit Function
Dim arrReturn : arrReturn = arr
Dim i
Dim count : count = Ubound(arr)
For i=0 To Ubound(arr)
arrReturn(i) = arr(count)
count= count - 1
Next
reverseArrayOrder = arrReturn
End Function
Function getRules(intNumberRules)
getRules = Null
Dim i, arrRulePrompts(), arrDefaultStarts(), arrDefaultSubs(), arrStartStrings, arrSubstituteStrings
ReDim arrRulePrompts (intNumberRules - 1)
ReDim arrDefaultStarts (intNumberRules - 1)
ReDim arrDefaultSubs (intNumberRules - 1)
'create arrays of strings to populate the Property List Boxes
For i = 0 To intNumberRules - 1
arrRulePrompts (i) = "Rule " & i & " Start String:"
'get the previously used rules from a file
arrDefaultStarts(i) = Rhino.GetSettings(Rhino.InstallFolder & "Lsystem.ini", "L-System", "DefaultStarts_" & i)
arrDefaultSubs (i) = Rhino.GetSettings(Rhino.InstallFolder & "Lsystem.ini", "L-System", "DefaultSubs_" & i)
If IsNull(arrDefaultStarts (i)) Then arrDefaultStarts (i) = "X_X..."
If IsNull(arrDefaultSubs (i)) Then arrDefaultSubs (i) = "X_X..."
Next
'prompt for the user to input the rules in two phases: first the strings that will be replaced - this will be in heirarchial order ie first rule will be enacted first
'longer strings (clauses) should be entered first.
'In the second phase the leters that will be substituted For the starting strings are entered underscores ("_") must seperate Each letter
arrStartStrings = Rhino.PropertyListBox (arrRulePrompts, arrDefaultStarts, "use CAPS for letters and space for delimiters", "L-System Rules: Start Strings")
arrSubstituteStrings = Rhino.PropertyListBox (arrStartStrings, arrDefaultSubs, "use CAPS for letters and space for delimiters", "L-System Rules: Substitute Strings")
For i = 0 To intNumberRules - 1
'write these rules to a file so that you don't have to re-enter them next time
Rhino.SaveSettings Rhino.InstallFolder & "Lsystem.ini", "L-System", "DefaultStarts_" & i, arrStartStrings(i)
Rhino.SaveSettings Rhino.InstallFolder & "Lsystem.ini", "L-System", "DefaultSubs_" & i, arrSubstituteStrings(i)
Next
getRules = array(arrStartStrings,arrSubstituteStrings)
End Function
Sub cleanUpLayers(arrCharacters, intGenerations)
Dim strCharacter
Call Rhino.EnableRedraw (vbFalse)
For Each strCharacter In arrCharacters
Call Rhino.AddLayer(strCharacter)
Dim arrObjects : arrObjects = Rhino.ObjectsByName(Ucase(strCharacter))
If Not IsNull(arrObjects) Then
Dim strObject
For Each strObject In arrObjects
Call Rhino.ObjectLayer(strObject, strCharacter)
Next
End If
Next
Dim i
For i=0 To intGenerations
Rhino.DeleteLayer(i)
Next
Call Rhino.EnableRedraw (vbTrue)
End Sub