RhinoScript dla on surface

From KokkugiaWiki

dla growth on a surface
this algorithm combines the elements we covered in the diffusion limited aggregation(dla) and the surface panelization classes .

Option Explicit
'------------------------------------------------------------------------------
' dla growth on surface 
' author: robert stuart-smith | 2009 | www.kokkugia.com

Call Main()
Sub Main()
	'define variables
	Dim strSrf,arrDomainU, arrDomainV, arrParam(1),test, iterations

	iterations = 1000
	
	'get a surface to grow on
	strSrf = Rhino.GetObject("pick that surface",8)
	'	get domains of surface (U & V DOMAINS)
	arrDomainU = Rhino.SurfaceDomain(strSrf,0)
	arrDomainV = Rhino.SurfaceDomain(strSrf,1)
	
	'	make an array for surface parameter
	arrParam(0) = arrDomainU(1)
	arrParam(1) = arrDomainV(1)
	
	'get seed locations
	Dim  arrTargets, arrTargetPts, i 
	arrTargets = Rhino.ObjectsByLayer("seeds")
	

	ReDim arrTargetPts(0)
	For i = 0 To Ubound(arrTargets)
		ReDim Preserve arrTargetPts(i)
		arrTargetPts(i) = Rhino.PointCoordinates(arrTargets(i))
	Next
	
	'create some arrays for positions and points
	Dim arrParticles, arrPos, arrPosNew, n
	Dim arrParaTemp
	ReDim arrParticles(0),arrPos(0),arrPosNew(2)
	
	n = 0
	'loop through iterations
	For i = 0 To iterations
		Rhino.EnableRedraw False
		ReDim Preserve arrPos(n)
		ReDim Preserve arrParticles(n)
		'	create a point
		arrParaTemp = Array(arrParam(0)*Rnd, arrParam(1)*Rnd)
		arrPosNew = Rhino.EvaluateSurface(strSrf,arrParaTemp)
		arrParticles(n) = Rhino.AddPoint(arrPosNew)
		'call function
		arrPos(n) =	MoveParticle(arrParticles(n), arrPos,arrPosNew,arrTargetPts, arrParam,arrParaTemp, strSrf,150)
		If Not Rhino.VectorCompare(arrPos(n), Array(0,0,0)) = 0 Then
			n = n + 1
		End If
	Next
	Rhino.EnableRedraw True
	
End Sub



Function MoveParticle(strParticle, arrPos,arrPosCurrent,arrTargetPts, arrParam,arrParaTemp, strSrf,lifeSpan)
	If lifeSpan > 0 Then
		Dim dblDist, arrPosNew, i
		'	check position to seeds
		For i = 0 To Ubound(arrTargetPts)
			dblDist = Rhino.Distance(arrTargetPts(i), arrPosCurrent)
			'	if in range - stick
			If dblDist < 2 Then
				MoveParticle = arrPosCurrent
				'	Rhino.AddLine arrTargetPts(i), arrPosCurrent
				Rhino.AddInterpCrvOnSrf strSrf,Array(arrTargetPts(i), arrPosCurrent)
				Exit Function
			End If
		Next
		
		'	check position to other points
		For i = 0 To Ubound(arrPos)-1
			dblDist = Rhino.Distance(arrPosCurrent, arrPos(i))
			'	if in range - stick
			If dblDist > 0.1 And dblDist < 2 Then
				MoveParticle = arrPosCurrent
				'Rhino.AddLine arrPos(i), arrPosCurrent
				Rhino.AddInterpCrvOnSrf strSrf,Array(arrPos(i), arrPosCurrent)
				Exit Function
			End If
		Next
		'	if not in range 
		arrPosNew = Rhino.EvaluateSurface(strSrf, Array(arrParaTemp(0)+ (arrParam(0)*Rnd/8),arrParaTemp(1)+ (arrParam(1)*Rnd/8)))
		Rhino.MoveObject strParticle, arrPosCurrent, arrPosNew
		'recursively call the function to do again
		MoveParticle =  MoveParticle(strParticle, arrPos,arrPosNew,arrTargetPts, arrParam,arrParaTemp, strSrf,lifeSpan - 1)
		'	if lifepan n is depleted - delete the mf
	Else 
		Rhino.DeleteObject strParticle
		MoveParticle =  Array(0,0,0)
	End If
End Function