RhinoScript dla

From KokkugiaWiki

scripting a diffusion-limited aggregation

Option Explicit
' diffusion-limited aggregation(DLA) algorithm 	
' robert stuart-smith | 2008 | www.kokkugia.com



Call Main()
Sub Main()
	'name variables
	Dim arrTargets,arrTargetPts
	Dim arrParticles, arrPosOld,arrPos, arrPosNew
	Dim arrVec1, arrVec2
	Dim i,j,k,n
	Dim iterations,population
	Dim arrCloud, arrCloudNew,arrPosTemp,arrCldPts
	
	'define iterations
	population = 300
	iterations = 1000
	arrTargets = Rhino.GetObjects("pick attractors")
	Rhino.AddLayer "particles", RGB(0, 0, 0)
	Rhino.AddLayer "aggregated", RGB(255, 0, 0)
	
	Rhino.EnableRedraw False
	
	'make an array of point coordinates for target points Array(x,y,z)
	ReDim arrTargetPts(0)
	For i = 0 To Ubound(arrTargets)
		ReDim Preserve	arrTargetPts(i)
		arrTargetPts(i) = Rhino.PointCoordinates	(arrTargets(i))
	Next
	
	'set initial sizes of arrays to store particles and particle positions
	ReDim arrParticles(0), arrPosNew(population,1),arrPosTemp(2)
	ReDim arrPos(0)
	
	n = 0
	'create a starting position for floating particles--------------
	For j = 0 To population-1	
		arrPosNew(j,0) = SeedPoint() 'call function to create new particle position & store in position array
		arrPosNew(j,1) = 300
	Next
	ReDim arrCldPts(0)
	For j = 0 To Ubound(arrPosNew)
		If IsArray(arrPosNew(j,0)) Then
			ReDim Preserve arrCldPts(j)
			arrCldPts(j) = arrPosNew(j,0)
		End If
	Next
	
	'build cloud of floating particles------------------
	Rhino.CurrentLayer("particles")
	arrCloudNew = Rhino.AddPointCloud(arrCldPts)	'add pointcloud to new positions
	Rhino.EnableRedraw True	
	
	'loop for iterations----------------------
	For i = 0 To iterations
		Rhino.EnableRedraw False
		ReDim Preserve arrPos(n)
		
		'loop through floating particles-----------------
		For j = 0 To population	
			'call function to check floating particle position-----
			arrPosTemp = MoveParticle(arrPosNew(j,0),arrPosNew(j,1),arrPos,arrTargetPts)		
			'based on distance evaluation, kill, stick, move particle
			If arrPosTemp(2) = 1 Then 'stick
				arrPos(n) = arrPosTemp(0)
				'Rhino.CurrentLayer("aggregated")
				'Rhino.AddPoint arrPos(n)
				n = n + 1
				ReDim Preserve arrPos(n)	 	
				arrPosNew(j,0) = SeedPoint()
				arrPosNew(j,1) = 300
			Else			
				arrPosNew(j,0) = arrPosTemp(0)
				arrPosNew(j,1) = arrPosTemp(1)		
			End If
		Next
		
		'update point cloud position of floating particles----------------
		ReDim arrCldPts(0)
		For j = 0 To Ubound(arrPosNew)
			If IsArray(arrPosNew(j,0)) Then
				ReDim Preserve arrCldPts(j)	
				arrCldPts(j) = arrPosNew(j,0)
			End If
		Next
		
		If Not IsEmpty(arrCloudNew)Then
			Rhino.DeleteObject arrCloudNew
		End If
		Rhino.CurrentLayer("particles")
		arrCloudNew = Rhino.AddPointCloud(arrCldPts)
		
		Rhino.EnableRedraw True		
	Next		
End Sub

Function SeedPoint()  'function to create new particle random position
	Dim dblNum, dblRad
	Dim arrVec
	
	dblNum = 40
	dblRad = 360
		
	arrVec = Rhino.VectorCreate(Array(0,1,0),Array(0,0,0))
	arrVec = Rhino.VectorRotate (arrVec,dblRad * Rnd, Array(1,0,0)) 
	arrVec = Rhino.VectorRotate (arrVec,dblRad * Rnd, Array(0,0,1)) 
	arrVec = Rhino.VectorScale(arrVec,dblNum) 
	
	SeedPoint = arrVec
	
End Function

Function MoveParticle(newParticlePos,lifespan,arrPos,arrTargetPts)
	Dim dblDist, arrPosNew
	Dim i,dblNum, dblRad

	dblNum = 10
	If lifespan > 0 Then
		'check distance to all target points----------
		For i = 0 To Ubound(arrTargetPts)
			dblDist = Rhino.Distance(arrTargetPts(i), newParticlePos)
			If dblDist < 5 Then
				MoveParticle = Array(newParticlePos,0,1)
				Rhino.CurrentLayer("aggregated")
				Rhino.AddLine arrTargetPts(i), newParticlePos
				Exit Function
			End If				
		Next
		
		'check distance to all stuck particles----------
		For i = 0 To Ubound(arrPos)-1
			dblDist = Rhino.Distance(newParticlePos, arrPos(i))
			If dblDist > 0.1 And dblDist < 5 Then
				MoveParticle = Array(newParticlePos,0,1)
				Rhino.CurrentLayer("aggregated")
				Rhino.AddLine arrPos(i), newParticlePos
				Exit Function
			End If	 
		Next

		arrPosNew =  Array(newParticlePos(0) + ((dblNum/3 * Rnd)-(dblNum/3 * Rnd)),newParticlePos(1) + ((dblNum/3  * Rnd)-(dblNum/3 * Rnd)),newParticlePos(2) + ((dblNum/3  * Rnd)-(dblNum/3 * Rnd)))
		MoveParticle = Array(arrPosNew,lifespan-1,2)
	Else
		MoveParticle = Array(SeedPoint(),0,300)
		Exit Function
	End If
	
End Function