surfaces.raindroppath.01

Option Explicit

‘Script written and copyrighted by David Rutten
‘Script adapted by J Maigret November 2009 University of Michigan
‘Reconstructivism.net
‘December 7th 2004 revision

Sub SimulateRainDropPaths()
Dim arrDropStart
Dim blnSmoothPath
Dim blnFancyPreview
Dim blnStopOnEdge
Dim SampleStepSize
Dim Tolerance
Dim idObject
Dim strResult, arrOptions
Dim arrPaths(), P, retVal
Dim selMesh
Dim strAllPts, arrAllPts(), obj, idAllPts, intCount, arrOnePt

blnSmoothPath = Rhino.GetSettings(Rhino.InstallFolder & “Gelfling.ini”, “DropSimulation”, “Smooth”)
If IsNull(blnSmoothPath) Then blnSmoothPath = vbFalse Else blnSmoothPath = CBool(blnSmoothPath)
blnFancyPreview = Rhino.GetSettings(Rhino.InstallFolder & “Gelfling.ini”, “DropSimulation”, “Fancy”)
If IsNull(blnFancyPreview) Then blnFancyPreview = vbFalse Else blnFancyPreview = CBool(blnFancyPreview)
blnStopOnEdge = Rhino.GetSettings(Rhino.InstallFolder & “Gelfling.ini”, “DropSimulation”, “StopOnEdge”)
If IsNull(blnStopOnEdge) Then blnStopOnEdge = vbFalse Else blnStopOnEdge = CBool(blnStopOnEdge)
SampleStepSize = Rhino.GetSettings(Rhino.InstallFolder & “Gelfling.ini”, “DropSimulation”, “SampleStepSize”)
If IsNull(SampleStepSize) Then SampleStepSize = 100 * Rhino.UnitAbsoluteTolerance Else SampleStepSize = CDbl(SampleStepSize)
Tolerance = Rhino.UnitAbsoluteTolerance

idObject = Rhino.GetObject(“Pick a surface for raindrop simulation”, 8+16, vbTrue, vbTrue)
If IsNull(idObject) Then Exit Sub

Rhino.EnableRedraw False
Rhino.Command “-_Mesh _PolygonDensity=50 _Enter”, vbFalse
selMesh = Rhino.LastCreatedObjects
If IsNull(selMesh) Then
msgBox “Geometry could not be meshes”, vbOkOnly Or vbCritical, “Drop simulation”
Exit Sub
Else
Rhino.HideObjects selMesh
End If
Rhino.EnableRedraw True

idAllPts = Rhino.GetObjects(“Select points to be used in simulation”, 1, vbTrue, vbTrue)
If IsNull(idAllPts) Then Exit Sub

intCount = 0

Do
If intCount > UBound(idAllPts) Then Exit Do
obj = idAllPts(intCount)
arrOnePt = Rhino.PointCoordinates(obj)
If IsNull(arrOnePt) Then Exit Do

ReDim Preserve arrAllPts(intCount)
arrAllPts(intCount) = arrOnePt

Call Rhino.Print(arrAllPts(intCount)(0)& “+” & arrAllPts(intCount)(1) & “+” & arrAllPts(intCount)(2))
Call Rhino.Print(intCount)

intCount = intCount + 1

Loop

P = 0
Do
‘arrOptions = Array(“Stepsize”, _
‘ “Tolerance”, _
‘ “Smooth_” & Bln2Str(blnSmoothPath), _
‘ “Simulate”, _
‘ “Finish”)
’strResult = Rhino.GetString(“Drop-path simulation”, “Simulate”, arrOptions)
‘If IsNull(strResult) Then strResult = “Finish”
‘If IsNumeric(strResult) Then
‘ SampleStepSize = Abs(CDbl(strResult))
‘ If SampleStepSize = 0 Then SampleStepSize = 100*Rhino.UnitAbsoluteTolerance
‘Else
‘Select Case UCase(Left(strResult, 2))
‘Case “ST”
’strResult = Rhino.GetReal(“Specify a new sample step size”, SampleStepSize, 10*Tolerance)
‘ If Not IsNull(strResult) Then SampleStepSize = strResult
SampleStepSize = 100*Rhino.UnitAbsoluteTolerance
‘Case “TO”
’strResult = Rhino.GetReal(“Specify a new sample progression tolerance”, Tolerance, Rhino.UnitAbsoluteTolerance/100, SampleStepSize/10)
‘If Not IsNull(strResult) Then Tolerance = strResult
Tolerance = Rhino.UnitAbsoluteTolerance/100
‘Case “SM”
‘blnSmoothPath = Not blnSmoothPath
‘Case “QU”
‘blnStopOnEdge = Not blnStopOnEdge
‘Case “SI”

If P > UBound(idAllPts) Then Exit Do
arrDropStart = arrAllPts(P)
Call Rhino.Print(arrDropStart(0)& “+” & arrDropStart(1) & “+” & arrDropStart(2))
If IsArray(arrDropStart) Then
retVal = SimulateDrop(idObject, arrDropStart, blnSmoothPath, blnStopOnEdge, SampleStepSize, Tolerance)
If IsNull(retVal) Then
msgBox “An error occured during the simulation”, vbOkOnly, “Drop simulation”
Else
ReDim Preserve arrPaths(P)
arrPaths(P) = retVal
P = P+1
End If
End If
‘Case “FI”
‘Exit Do
‘Case Else
‘Rhino.Command strResult
‘ End Select
Loop

Rhino.EnableRedraw False
Rhino.ShowObjects selMesh
Rhino.DeleteObjects selMesh
If P > 0 Then
Rhino.SelectObjects arrPaths
Rhino.UnselectObject idObject
End If
Rhino.EnableRedraw True

‘Rhino.SaveSettings Rhino.InstallFolder & “Gelfling.ini”, “DropSimulation”, “Smooth”, blnSmoothPath
‘Rhino.SaveSettings Rhino.InstallFolder & “Gelfling.ini”, “DropSimulation”, “Fancy”, blnFancyPreview
‘Rhino.SaveSettings Rhino.InstallFolder & “Gelfling.ini”, “DropSimulation”, “StopOnEdge”, blnStopOnEdge
‘Rhino.SaveSettings Rhino.InstallFolder & “Gelfling.ini”, “DropSimulation”, “SampleStepSize”, SampleStepSize

Rhino.Print “Raindrop simulation finished”
End Sub
SimulateRainDropPaths

Function SimulateDrop(ByVal idObject, ByVal DropStart, ByVal blnSmoothPath, ByVal blnStopOnEdge, ByVal SampleStepSize, ByVal Tolerance)
SimulateDrop = Null
Dim BBox, S
Dim idPath, arrVertices()
Dim BrepCP
Dim curPt, lowPt, newPt
Dim idPreview, PreviewSize

BBox = Rhino.BoundingBox(idObject)
If IsNull(BBox) Then Exit Function

BrepCP = Rhino.BrepClosestPoint(idObject, DropStart)
curPt = BrepCP(0)
idPreview = “Nothing”
PreviewSize = FastDistance(BBox(0), BBox(6))/500

‘If blnFancyPreview Then Rhino.LockObject idObject

If Not IsNull(curPt) Then
ReDim arrVertices(0)
arrVertices(0) = curPt
S = 0
Do
lowPt = Array(curPt(0), curPt(1), curPt(2)-SampleStepSize)
BrepCP = Rhino.BRepClosestPoint(idObject, lowPt)
newPt = BrepCP(0)

If FastDistance(newPt, curPt) curPt(2) Then Exit Do
ReDim Preserve arrVertices(S)
arrVertices(S) = newPt
S = S+1

‘If blnStopOnEdge And BrepCP(2) 1342177280 Then Exit Do
‘If blnFancyPreview Then
‘ Rhino.EnableRedraw False
‘ Rhino.DeleteObject idPreview
‘ idPreview = DrawFancyArrow(curPt, newPt, PreviewSize)
‘ Rhino.EnableRedraw True
‘End If

curPt = newPt
Loop

Rhino.DeleteObject idPreview
Rhino.UnlockObject idObject
If blnSmoothPath Then
idPath = Rhino.AddCurve(arrVertices, 3)
Else
idPath = Rhino.AddPolyLine(arrVertices)
End If
Else
Rhino.Print “Drop could be projected to the surface… an error occured”
Exit Function
End If

SimulateDrop = idPath
End Function

Function FastDistance(Byval arr1, Byval arr2)
FastDistance = (arr1(0)-arr2(0))*(arr1(0)-arr2(0)) + (arr1(1)-arr2(1))*(arr1(1)-arr2(1)) + (arr1(2)-arr2(2))*(arr1(2)-arr2(2))
FastDistance = Sqr(FastDistance)
End Function

Function Bln2Str(Byval input)
If input Then
Bln2Str = “Yes”
Exit Function
Else
Bln2Str = “No”
Exit Function
End If
End Function

surfaces.tiling.hexagons.01

Option Explicit
‘Script written by www.supermanoeuvre.com

Call srfPanelsHexagons()

Sub srfPanelsHexagons()

‘——————————————————————————————————
‘ USER INPUT
Dim arrNames(1)
arrNames(0) = “CRVS”
arrNames(1) = “SRFS”

Dim strCmd : strCmd = rhino.GetString(“How do u want your hexagons”,, arrNames )
If isNull(strCmd) Then Exit Sub

Dim strSrf : strSrf = rhino.getObject(“Gimme SURFACE object!”,
If isNull(strSrf) Then Exit Sub

Dim numSpans : numSpans = rhino.GetInteger(“Gimme number of surface spans in each direction”, 15, 6, 50)
If isNull(numSpans) Then Exit Sub

‘——————————————————————————————————
‘ SCRIPT BODY
rhino.print “!!! SCRIPT STARTED !!!”
rhino.enableRedraw False

‘——————————————————-
‘ Get U vals
Dim arrSrfDomU : arrSrfDomU = Rhino.SurfaceDomain(strSrf,0)
Dim uMin : uMin = arrSrfDomU(0)
Dim uMax : uMax = arrSrfDomU(1)
Dim uStep : uStep = (uMax-uMin) / numSpans

‘——————————————————-
‘ Get V vals
Dim arrSrfDomV : arrSrfDomV = Rhino.SurfaceDomain(strSrf,1)
Dim vMin : vMin = arrSrfDomV(0)
Dim vMax : vMax = arrSrfDomV(1)
Dim vStep : vStep = (vMax-vMin) / numSpans

‘——————————————————-
‘ Create hexagons
Dim i,j

For i = 0 To numSpans -1 Step 1
For j = 0 To numSpans -1 Step 1

ReDim arrPtsCnr(6)

If abs(j) Mod 2 Then
arrPtsCnr(0) = Rhino.EvaluateSurface(strSrf, Array(uStep*i+uStep/3,vStep*j))
arrPtsCnr(1) = Rhino.EvaluateSurface(strSrf, Array(uStep*i+uStep/6,vStep*j+vStep))
arrPtsCnr(2) = Rhino.EvaluateSurface(strSrf, Array(uStep*i-uStep/6,vStep*j+vStep))
arrPtsCnr(3) = Rhino.EvaluateSurface(strSrf, Array(uStep*i-uStep/3,vStep*j))
arrPtsCnr(4) = Rhino.EvaluateSurface(strSrf, Array(uStep*i-uStep/6,vStep*j-vStep))
arrPtsCnr(5) = Rhino.EvaluateSurface(strSrf, Array(uStep*i+uStep/6,vStep*j-vStep))
arrPtsCnr(6) = arrPtsCnr(0)
‘ Add hexagon
Select Case strCmd
Case “CRVS”
Rhino.AddPolyline arrPtsCnr
Case “SRFS”
addHex(arrPtsCnr)
End Select
Else
If j>0 And j<numSpans Then
' get points
arrPtsCnr(0) = Rhino.EvaluateSurface(strSrf, Array(uStep*.5+uStep*i+uStep/3,vStep*j))
arrPtsCnr(1) = Rhino.EvaluateSurface(strSrf, Array(uStep*.5+uStep*i+uStep/6,vStep*j+vStep))
arrPtsCnr(2) = Rhino.EvaluateSurface(strSrf, Array(uStep*.5+uStep*i-uStep/6,vStep*j+vStep))
arrPtsCnr(3) = Rhino.EvaluateSurface(strSrf, Array(uStep*.5+uStep*i-uStep/3,vStep*j))
arrPtsCnr(4) = Rhino.EvaluateSurface(strSrf, Array(uStep*.5+uStep*i-uStep/6,vStep*j-vStep))
arrPtsCnr(5) = Rhino.EvaluateSurface(strSrf, Array(uStep*.5+uStep*i+uStep/6,vStep*j-vStep))
arrPtsCnr(6) = arrPtsCnr(0)
' Add hexagon
Select Case strCmd
Case "CRVS"
Rhino.AddPolyline arrPtsCnr
Case "SRFS"
addHex(arrPtsCnr)
End Select
End If

End If

Next ' end j loop

Next ' end i loop

rhino.enableRedraw True
rhino.print "!!! SCRIPT COMPLETED !!!"

End Sub

Function addHex(PTS)

' This function establishes a centroid for the hexagon
' Then builds & groups the triangulated surfaces that make up each hex

addHex = Null

' As points do not define a planar curve
' We need to calculate the centroid of the 6 points
Dim i, arrPtCntr
Dim arrSum : arrSum = Array(0,0,0)
Dim counter : counter = 0
For i = 0 To ubound(PTS)
arrSum = rhino.VectorAdd( arrSum, PTS(i) )
counter = counter + 1
Next
' Average position
arrPtCntr = rhino.VectorDivide( arrSum, counter )

' Make triangular surfaces that create a hexagon surface
Dim j
Dim strGroup
ReDim arrSrfTmp(5)

For j = 0 To ubound(PTS) – 1
ReDim arrPts(2)
If j = 5 Then
arrPts(0) = PTS(j)
arrPts(1) = PTS(0)
arrPts(2) = arrPtCntr
arrSrfTmp(j) = rhino.addSrfPt( arrPts )
Else
arrPts(0) = PTS(j)
arrPts(1) = PTS(j+1)
arrPts(2) = arrPtCntr
arrSrfTmp(j) = rhino.addSrfPt( arrPts )
End If
Next

' Assign some random colour
Rhino.ObjectColor arrSrfTmp, 255 – ( 255 * 1 / rnd*255 )

' group the new surface objects
strGroup = Rhino.AddGroup
Rhino.AddObjectsToGroup arrSrfTmp, strGroup

End Function

surfaces.tiling.rectangles.01

Option Explicit
‘Script written by www.supermanoeuvre.com

Call srfPanelsQuads()

Sub srfPanelsQuads()

‘——————————————————————————————————
‘ USER INPUT
Dim strSrf : strSrf = rhino.getObject(“Gimme SURFACE object!”,
If isNull(strSrf) Then Exit Sub

Dim numSpans : numSpans = rhino.GetInteger(“Gimme number of surface spans in each direction”, 15, 6, 50)
If isNull(numSpans) Then Exit Sub

‘——————————————————————————————————
‘ SCRIPT BODY
rhino.print “!!! SCRIPT STARTED !!!”
rhino.enableRedraw False

‘——————————————————-
‘ Get U vals
Dim arrSrfDomU : arrSrfDomU = Rhino.SurfaceDomain(strSrf,0)
Dim uMin : uMin = arrSrfDomU(0)
Dim uMax : uMax = arrSrfDomU(1)
Dim uStep : uStep = (uMax-uMin) / numSpans

‘——————————————————-
‘ Get V vals
Dim arrSrfDomV : arrSrfDomV = Rhino.SurfaceDomain(strSrf,1)
Dim vMin : vMin = arrSrfDomV(0)
Dim vMax : vMax = arrSrfDomV(1)
Dim vStep : vStep = (vMax-vMin) / numSpans

‘——————————————————-
‘ Create nodes
Dim i,j
Dim arrEvalPt01, arrEvalPt02, arrEvalPt03, arrEvalPt04, arrCnrPts

For i = uMin To uMax – uStep Step uStep
For j = vMin To vMax – vStep Step vStep
‘ define quad corners
arrEvalPt01 = Rhino.EvaluateSurface( strSrf, Array(i,j) )
arrEvalPt02 = Rhino.EvaluateSurface( strSrf, Array(i,j+vStep) )
arrEvalPt03 = Rhino.EvaluateSurface( strSrf, Array(i+uStep,j+vStep) )
arrEvalPt04 = Rhino.EvaluateSurface( strSrf, Array(i+uStep, j) )

‘ put corner points in an array
arrCnrPts = Array( arrEvalPt01, arrEvalPt02, arrEvalPt03, arrEvalPt04 )
Rhino.AddSrfPt arrCnrPts

Next ‘ end j loop

Next ‘ end i loop

rhino.enableRedraw True
rhino.print “!!! SCRIPT COMPLETED !!!”

End Sub

surfaces.tiling.triangles.01

Option Explicit
‘Script written by www.supermanoeuvre.com

Call srfPanelsTriangles()

Sub srfPanelsTriangles()

‘——————————————————————————————————
‘ USER INPUT
Dim strSrf : strSrf = rhino.getObject(“Gimme SURFACE object!”,
If isNull(strSrf) Then Exit Sub

Dim numSpans : numSpans = rhino.GetInteger(“Gimme number of surface spans in each direction”, 15, 6, 50)
If isNull(numSpans) Then Exit Sub

‘——————————————————————————————————
‘ SCRIPT BODY
rhino.print “!!! SCRIPT STARTED !!!”
rhino.enableRedraw False

‘——————————————————-
‘ Get U vals
Dim arrSrfDomU : arrSrfDomU = Rhino.SurfaceDomain(strSrf,0)
Dim uMin : uMin = arrSrfDomU(0)
Dim uMax : uMax = arrSrfDomU(1)
Dim uStep : uStep = (uMax-uMin) / numSpans

‘——————————————————-
‘ Get V vals
Dim arrSrfDomV : arrSrfDomV = Rhino.SurfaceDomain(strSrf,1)
Dim vMin : vMin = arrSrfDomV(0)
Dim vMax : vMax = arrSrfDomV(1)
Dim vStep : vStep = (vMax-vMin) / numSpans

‘——————————————————-
‘ Create nodes
Dim i,j
Dim arrEvalPt01, arrEvalPt02, arrEvalPt03, arrEvalPt04, arrEvalPt05, arrEvalPt06, arrCnrPts

For i = uMin To uMax – uStep Step uStep
For j = vMin To vMax – vStep Step vStep
‘ first triangle
arrEvalPt01 = Rhino.EvaluateSurface( strSrf, Array(i,j) )
arrEvalPt02 = Rhino.EvaluateSurface( strSrf, Array(i,j+vStep) )
arrEvalPt03 = Rhino.EvaluateSurface( strSrf, Array(i+uStep,j) )
‘ second triangle
arrEvalPt04 = Rhino.EvaluateSurface( strSrf, Array(i+uStep,j) )
arrEvalPt05 = Rhino.EvaluateSurface( strSrf, Array(i+uStep,j+vStep) )
arrEvalPt06 = Rhino.EvaluateSurface( strSrf, Array(i,j+vStep) )

‘ put corner points in an array
arrCnrPts = Array( arrEvalPt01, arrEvalPt02, arrEvalPt03 )
Rhino.AddSrfPt arrCnrPts
arrCnrPts = Array( arrEvalPt04, arrEvalPt05, arrEvalPt06 )
Rhino.AddSrfPt arrCnrPts

Next ‘ end j loop

Next ‘ end i loop

rhino.enableRedraw True
rhino.print “!!! SCRIPT COMPLETED !!!”

End Sub

agents.particlesystem.01

Option Explicit
‘ Script written by www.supermanoeuvre.com
‘ draws particle population as a pointCloud object

Call Main()

Sub Main()

‘ General Setup
Dim maxTimeSteps : maxTimeSteps = 1000
If isNull(maxTimeSteps) Then Exit Sub
Dim numParticles : numParticles = 75
If isNull(numParticles) Then Exit Sub

‘ Environment Size
Dim envsizeX : envsizeX = 100
Dim envsizeY : envsizeY = 100
Dim envsizeZ : envsizeZ = 100

‘ Particle Variables
Dim maxVel : maxVel = 0.5 ‘ Maximum speed of the partcle
Dim dblGravity : dblGravity = -0.0 ‘ Gravity push on the particles

rhino.Print ” “
rhino.Print “!!! SCRIPT STARTED !!!”

‘ Set and Draw Environment
Call Rhino.ViewDisplayMode(“Perspective”,0)
Call makeEnvironment(envsizeX,envsizeX,envsizeX)

‘——————————————————————————–
‘ MAKE PARTICLES
‘Each agent is described as — Array( pos(0), vel(1), maxVel(2) )
Dim i
Dim arrParticles()

Dim arrPtStart: arrPtStart = Array( envsizeX/2, envsizeY/2, envsizeZ/2 )

For i = 0 To numParticles -1

Dim rndVel : rndVel = randomVector()
ReDim Preserve arrParticles(i)
arrParticles(i) = Array( arrPtStart, rndVel, maxVel )
Next

‘——————————————————————————–
‘ ITERATE SIMULATION
Dim j,k
Dim particleCloud

particleCloud = Null

For j = 0 To maxTimeSteps-1

rhino.enableRedraw False

‘————————————————————-
‘ UPDATE EACH PARTICLES’S POSITION
For k = 0 To ubound(arrParticles)
‘ FORCES ON THE PARTICLE
‘ Any force acting on the particle – e.g. gravity – is added to the particle’s acceleration
Dim arrAcc, fGravity, arrNewVel
arrAcc = Array(0,0,0)
fGravity = Array(0,0,dblGravity)
arrAcc = rhino.VectorAdd( arrAcc, fGravity )
‘ Add acceleration to current particle velocity
arrNewVel = rhino.VectorAdd( arrParticles(k)(1), arrAcc )
‘ Limit velocity to maxVel
arrNewVel = vectorLimit( arrNewVel, arrParticles(k)(2) )

arrParticles(k)(0) = rhino.VectorAdd( arrParticles(k)(0), arrNewVel )

Next

‘—————————————————
‘ DRAW PARTICLES
‘ generate array of all particle coords
Dim m
Dim arrPosToroid
ReDim arrParticlePos(-1)
For m = 0 To ubound(arrParticles)
arrPosToroid = borders( arrParticles(m), envsizeX, envsizeY, envsizeZ )
arrParticles(m)(0) = arrPosToroid
ReDim Preserve arrParticlePos(m)
arrParticlePos(m) = arrParticles(m)(0)
Next

If Not isNull(particleCloud) Then
rhino.deleteObject particleCloud
End If

particleCloud = Rhino.AddPointCloud(arrParticlePos)

‘ redraw to update view
Rhino.EnableRedraw True
rhino.Print “Current time step is : ” & j+1

Next

rhino.Print “!!! SCRIPT COMPLETE !!!”

End Sub

‘ Draws a box the size of the defined environemnt
Function makeEnvironment(XX,YY,ZZ)

makeEnvironment = Null

Dim arrCnrs(7)
arrCnrs(0) = Array(0,0,0)
arrCnrs(1) = Array(XX,0,0)
arrCnrs(2) = Array(XX,YY,0)
arrCnrs(3) = Array(0,YY,0)
arrCnrs(4) = Array(0,0,ZZ)
arrCnrs(5) = Array(XX,0,ZZ)
arrCnrs(6) = Array(XX,YY,ZZ)
arrCnrs(7) = Array(0,YY,ZZ)

rhino.addBox arrCnrs

End Function

Function vectorLimit(V1, LIMIT)

vectorLimit = Null

Dim arrVec
Dim dblLength : dblLength = Rhino.VectorLength(V1)

If dblLength > LIMIT Then
arrVec = rhino.VectorUnitize(V1)
vectorLimit = rhino.VectorScale(arrVec, LIMIT)
Else
vectorLimit = V1
End If

End Function

‘ Returns a vector with values between -1 & 1
Function randomVector()

randomVector = Null

Dim i
‘ An array of negative or positive operators
ReDim switch(2)
For i = 0 To 2
Dim rndNum : rndNum = rnd*1
ReDim Preserve switch(i)
If rndNum > 0.5 Then
switch(i) = 1
Else
switch(i) = -1
End If
Next

‘3D
randomVector = Array( switch(0)*(rnd*1), switch(1)*(rnd*1), switch(2)*(rnd*1) )

End Function

Function borders(PARTICLE, XX, YY, ZZ)

borders = Null

Dim newX, newY, newZ

‘ Solve for X coordinate
If PARTICLE(0)(0) XX Then
newX = 0
Else
newX = PARTICLE(0)(0)
End If

‘ Solve for X coordinate
If PARTICLE(0)(1) XX Then
newY = 0
Else
newY = PARTICLE(0)(1)
End If

‘ Solve for X coordinate
If PARTICLE(0)(2) ZZ Then
newZ = 0
Else
newZ = PARTICLE(0)(2)
End If

borders = Array(newX, newY, newZ)

End Function

agents.system.01

Option Explicit
‘ Script written by maxi@supermanoeuvre.com
‘ draws agent population as a pointCloud object

Call AgentSwarm()

Sub AgentSwarm()

Dim maxTimeSteps : maxTimeSteps = 1000
If isNull(maxTimeSteps) Then Exit Sub
Dim numAgents : numAgents = 25
If isNull(numAgents) Then Exit Sub

Dim envsizeX : envsizeX = 100
Dim envsizeY : envsizeY = 100
Dim envsizeZ : envsizeZ = 100

rhino.Print ” “
rhino.Print “!!! SCRIPT STARTED !!!”

‘ Set and Draw Environment
Call Rhino.ViewDisplayMode(“Perspective”,0)
Call makeEnvironment(envsizeX,envsizeX,envsizeX)

‘——————————————————————————–
‘ MAKE AGENTS
‘Each agent is described as — Array( pos(0), vel(1), maxVel(2), maxForce(3) )

Dim i
Dim arrAgents()
Dim maxVel : maxVel = 0.75
Dim maxForce : maxForce = 0.25
Dim rangeOfVision : rangeOfVision = 20

Dim alignScale : alignScale = 0.8
Dim cohScale : cohScale = 0.5
Dim sepScale : sepScale = 12.0

For i = 0 To numAgents -1
Dim rndStart : rndStart = randomStart(envsizeX,envsizeX,envsizeX)
Dim rndVel : rndVel = randomVelocity()
ReDim Preserve arrAgents(i)
arrAgents(i) = Array( rndStart, rndVel, maxVel, maxForce )
Next

‘——————————————————————————–
‘ ITERATE SIMULATION
Dim j,k
Dim currAgent, otherAgent
Dim swarmCloud

swarmCloud = Null

For j = 0 To maxTimeSteps-1

rhino.enableRedraw False

‘—————————————————-
‘ UPDATE EACH AGENT’S POSITION
For k = 0 To ubound(arrAgents)

‘ The steering forces
Dim arrAcc, arrNewVel, vecSep, vecCoh, vecAli
‘ Reset acceleration
arrAcc = Array(0,0,0)
‘ Get steering vectors
vecSep = agentSeparate( arrAgents(k), arrAgents, rangeOfVision )
vecCoh = agentCohesion( arrAgents(k), arrAgents, rangeOfVision )
vecAli = agentAlign ( arrAgents(k), arrAgents, rangeOfVision )
‘ Scale steering forces
vecSep = rhino.vectorScale(vecCoh, sepScale)
vecCoh = rhino.vectorScale(vecCoh, cohScale)
vecAli = rhino.vectorScale(vecCoh, alignScale)
‘ Update agents position
arrAcc = rhino.vectorAdd(arrAcc, vecSep)
arrAcc = rhino.vectorAdd(arrAcc, vecCoh)
arrAcc = rhino.vectorAdd(arrAcc, vecAli)

arrNewVel = rhino.VectorAdd( arrAgents(k)(1), arrAcc ) ‘ Add acceleration to velocity
arrNewVel = vectorLimit( arrNewVel, arrAgents(k)(2) ) ‘ Limit velocity

arrAgents(k)(0) = rhino.VectorAdd( arrAgents(k)(0), arrNewVel )

Next

‘—————————————————
‘ DRAW AGENTS
‘ generate array of all agent coords
Dim m
Dim arrPosToroid
ReDim arrAgentPos(-1)
For m = 0 To ubound(arrAgents)
arrPosToroid = borders( arrAgents(m), envsizeX, envsizeY, envsizeZ )
arrAgents(m)(0) = arrPosToroid
ReDim Preserve arrAgentPos(m)
arrAgentPos(m) = arrAgents(m)(0)
Next

If Not isNull(swarmCloud) Then
rhino.deleteObject swarmCloud
End If

swarmCloud = Rhino.AddPointCloud(arrAgentPos)
Rhino.EnableRedraw True
rhino.Print “Current time step is : ” & j+1

Next

rhino.Print “!!! SCRIPT COMPLETE !!!”

End Sub

Function borders(AGENT, XX, YY, ZZ)

borders = Null

Dim newX, newY, newZ

‘ Solve for X coordinate
If AGENT(0)(0) XX Then
newX = 0
Else
newX = AGENT(0)(0)
End If

‘ Solve for X coordinate
If AGENT(0)(1) XX Then
newY = 0
Else
newY = AGENT(0)(1)
End If

‘ Solve for X coordinate
If AGENT(0)(2) ZZ Then
newZ = 0
Else
newZ = AGENT(0)(2)
End If

borders = Array(newX, newY, newZ)

End Function

‘ Draws a box the size of the defined environemnt
Function makeEnvironment(XX,YY,ZZ)

makeEnvironment = Null

Dim arrCnrs(7)
arrCnrs(0) = Array(0,0,0)
arrCnrs(1) = Array(XX,0,0)
arrCnrs(2) = Array(XX,YY,0)
arrCnrs(3) = Array(0,YY,0)
arrCnrs(4) = Array(0,0,ZZ)
arrCnrs(5) = Array(XX,0,ZZ)
arrCnrs(6) = Array(XX,YY,ZZ)
arrCnrs(7) = Array(0,YY,ZZ)

rhino.addBox arrCnrs

End Function

Function randomStart(envX, envY, envZ)

randomStart = Null

Dim arrVec : arrVec = Array( rnd*envX, rnd*envY, rnd*envZ )

randomStart = arrVec

End Function

Function randomVelocity()

randomVelocity = Null

Dim i

ReDim switch(2)
For i = 0 To 2
Dim rndNum : rndNum = rnd*1
ReDim Preserve switch(i)
If rndNum > 0.5 Then
switch(i) = 1
Else
switch(i) = -1
End If
Next

randomVelocity = Array( switch(0)*(rnd*1), switch(1)*(rnd*1), switch(2)*(rnd*1) )

End Function

Function vectorLimit(V1, LIMIT)

vectorLimit = Null

Dim arrVec
Dim dblLength : dblLength = Rhino.VectorLength(V1)

If dblLength > LIMIT Then
arrVec = rhino.VectorUnitize(V1)
vectorLimit = rhino.VectorScale(arrVec, LIMIT)
Else
vectorLimit = V1
End If

End Function

Function printAgent(AGENT)

Dim i
For i = 0 To ubound(AGENT)
If i = 0 Then rhino.print “position ” & pt2str(AGENT(0))
If i = 1 Then rhino.print “velocity ” & pt2str(AGENT(1))
If i = 2 Then rhino.print “maximum velocity is ” & AGENT(2)
If i = 3 Then rhino.print “maximum force is ” & AGENT(3)
Next

End Function

Function steer( AGENT, TARGET, RNG )

steer = Null

Dim vec2Target, dblLength, vecSteer

vec2Target = Rhino.VectorSubtract( AGENT(0), TARGET )
dblLength = Rhino.VectorLength( vec2Target )

If dblLength > 0 And dblLength 0 And dblDist 0 Then
Dim steerForce ‘ the lateral steering force to apply
arrSum = rhino.vectorDivide(arrSum, counter)
steerForce = steer( AGENT, arrSum, RNG )
agentCohesion = steerForce
Else
agentCohesion = arrSum
End If

End Function

Function agentSeparate( AGENT, POP, RNG )

‘ Separate works by applying a negative steering force to the average position of an agents neighbours
‘ sum of all positions / number of agents

agentSeparate = Null

Dim i, dblDist, counter
Dim arrSum : arrSum = Array(0,0,0)
Dim sepVec

counter = 0

For i = 0 To ubound(POP)
dblDist = rhino.Distance( AGENT(0), POP(i)(0) )
If dblDist > 0 And dblDist 0 Then
arrSum = rhino.vectorDivide(arrSum, counter)
arrSum = vectorLimit(arrSum, AGENT(3))
End If

agentSeparate = arrSum

End Function

Function agentAlign( AGENT, POP, RNG )

‘ Align works by averaging the headings of all neighbouring agents
‘ sum of all velocities / number of agents

agentAlign = Null

Dim i, dblDist, counter
Dim arrSum : arrSum = Array(0,0,0)

counter = 0

For i = 0 To ubound(POP)
dblDist = rhino.Distance( AGENT(0), POP(i)(0) )
If dblDist > 0 And dblDist 0 Then
arrSum = rhino.vectorDivide(arrSum, counter)
arrSum = vectorLimit(arrSum, AGENT(3))
End If

agentAlign = arrSum

End Function

agents.pointcloud.01

Option Explicit
‘ Script written by www.supermanoeuvre.com
‘ draws agent population as a pointCloud object

Call Main()

Sub Main()

‘ General Setup
Dim maxTimeSteps : maxTimeSteps = 5000
If isNull(maxTimeSteps) Then Exit Sub
Dim numParticles : numParticles = 50
If isNull(numParticles) Then Exit Sub

‘ Environment Size
Dim envsizeX : envsizeX = 100
Dim envsizeY : envsizeY = 100
Dim envsizeZ : envsizeZ = 100

‘ Particle Variables
Dim maxVel : maxVel = 1.0 ‘ Maximum speed of the partcle
Dim dblGravity : dblGravity = -0.0 ‘ Gravity push on the particles

‘ Aggregation Variables
Dim dblRng : dblRng = 5.0 ‘ If particle is this close to a cell then create a new aggregate
ReDim Preserve aggregateCells(-1)

rhino.Print ” “
rhino.Print “!!! SCRIPT STARTED !!!”

‘ Set and Draw Environment
Call Rhino.ViewDisplayMode(“Perspective”,0)
rhino.addLayer “WORLD”
rhino.CurrentLayer “WORLD”
Call makeEnvironment(envsizeX,envsizeX,envsizeX)

‘——————————————————————————–
‘ MAKE STARTING AGGREGATE CELL
rhino.addLayer “AGGREGATES”, RGB(255,0,0)
rhino.CurrentLayer “AGGREGATES”
ReDim Preserve aggregateCells(0)
aggregateCells(0) = rhino.addPoint( Array(envsizeX/2, envsizeY/2, envsizeZ/2 ) )

‘——————————————————————————–
‘ MAKE PARTICLES
‘Each agent is described as — Array( pos(0), vel(1), maxVel(2) )
rhino.addLayer “PARTICLES”
rhino.CurrentLayer “PARTICLES”

Dim i
Dim arrParticles()

For i = 0 To numParticles -1
Dim rndStart : rndStart = randomStart(envsizeX,envsizeX,envsizeX)
Dim rndVel : rndVel = randomVelocity()
ReDim Preserve arrParticles(i)
arrParticles(i) = Array( Array( rnd*envsizeX, rnd*envsizeY, rnd*envsizeZ ), rndVel, maxVel )
Next

‘——————————————————————————–
‘ ITERATE SIMULATION
Dim j,k
Dim particleCloud

particleCloud = Null

For j = 0 To maxTimeSteps-1

rhino.enableRedraw False

‘————————————————————-
‘ UPDATE EACH PARTICLES’S POSITION
For k = 0 To ubound(arrParticles)
‘ FORCES ON THE PARTICLE
‘ Any force acting on the particle – e.g. gravity – is added to the particle’s acceleration
Dim arrAcc, fGravity, arrNewVel
arrAcc = Array(0,0,0)
fGravity = Array(0,0,dblGravity)
arrAcc = rhino.VectorAdd( arrAcc, fGravity )
‘ Add acceleration to current particle velocity
arrNewVel = rhino.VectorAdd( arrParticles(k)(1), arrAcc )
‘ Limit velocity to maxVel
arrNewVel = vectorLimit( arrNewVel, arrParticles(k)(2) )

arrParticles(k)(0) = rhino.VectorAdd( arrParticles(k)(0), arrNewVel )

Next

‘—————————————————
‘ CHECK AGGREGATES & DRAW PARTICLES
‘ generate array of all particle coords
Dim m
Dim arrPosToroid
ReDim arrParticlePos(-1)
For m = 0 To ubound(arrParticles)
arrPosToroid = borders( arrParticles(m), envsizeX, envsizeY, envsizeZ )
arrParticles(m)(0) = arrPosToroid
ReDim Preserve arrParticlePos(m)
arrParticlePos(m) = arrParticles(m)(0)

‘———————————————–
‘ Check position against all current aggregates
Dim tmpCell : tmpCell = checkAggregates(arrParticles(m)(0), aggregateCells, dblRng)
‘ If location is good then make new cell
If Not isNull(tmpCell) Then
ReDim Preserve aggregateCells( ubound(aggregateCells) +1)
aggregateCells( ubound(aggregateCells)) = tmpCell
‘ reset the particle to a new starting position & new velocity
arrParticles(m)(0) = randomStart(envsizeX,envsizeX,envsizeX)
arrParticles(m)(1) = randomVelocity()
End If

Next

‘—————————————————–
‘ Delete old pointcloud and draw new one
If Not isNull(particleCloud) Then
rhino.deleteObject particleCloud
End If

rhino.CurrentLayer “PARTICLES”
particleCloud = Rhino.AddPointCloud(arrParticlePos)

‘ redraw to update view
Rhino.EnableRedraw True
rhino.Print “Current time step is : ” & j+1

Next

rhino.Print “!!! SCRIPT COMPLETE !!!”

End Sub

Function checkAggregates(POS, AGGS, RNG)

checkAggregates = Null

‘ Variables
Dim i, index, distClosest, arrPtTest, distTest, strNewObj
index = 0
distClosest = 9999999
‘ Loop to find nearest aggregate
For i = 0 To ubound(AGGS)
arrPtTest = rhino.pointCoordinates( AGGS(i) )
distTest = rhino.Distance(POS,arrPtTest)
If distTest < distClosest Then
distClosest = distTest
index = i
End If
Next
' If in range make a new aggregate
If distClosest 0.5 Then
‘ random XX & constant YY value
If kToggle > 0.5 Then
arrVec = Array(rnd*envX, envY, envZ)
Else
arrVec = Array(rnd*envX, 0, 0)
End If
Else
‘ constant XX & random YY value
If kToggle > 0.5 Then
arrVec = Array(0, rnd*envY, 0)
Else
arrVec = Array(envX, rnd*envY, envZ)
End If
End If

randomStart = arrVec

End Function

‘ Returns a vector with values between -1 & 1
Function randomVelocity()

randomVelocity = Null

Dim i
‘ An array of negative or positive operators
ReDim switch(2)
For i = 0 To 2
Dim rndNum : rndNum = rnd*1
ReDim Preserve switch(i)
If rndNum > 0.5 Then
switch(i) = 1
Else
switch(i) = -1
End If
Next

randomVelocity = Array( switch(0)*(rnd*1), switch(1)*(rnd*1), switch(2)*(rnd*1) )

End Function

‘ Toroidal space – if particle leaves the environment it returns on the opposite
Function borders(PARTICLE, XX, YY, ZZ)

borders = Null

Dim newX, newY, newZ

‘ Solve for X coordinate
If PARTICLE(0)(0) XX Then
newX = 0
Else
newX = PARTICLE(0)(0)
End If

‘ Solve for X coordinate
If PARTICLE(0)(1) XX Then
newY = 0
Else
newY = PARTICLE(0)(1)
End If

‘ Solve for X coordinate
If PARTICLE(0)(2) ZZ Then
newZ = 0
Else
newZ = PARTICLE(0)(2)
End If

borders = Array(newX, newY, newZ)

End Function

‘ Limits the magnitude of a vector to a given limit
Function vectorLimit(V1, LIMIT)

vectorLimit = Null

Dim arrVec
Dim dblLength : dblLength = Rhino.VectorLength(V1)

If dblLength > LIMIT Then
arrVec = rhino.VectorUnitize(V1)
vectorLimit = rhino.VectorScale(arrVec, LIMIT)
Else
vectorLimit = V1
End If

End Function

‘ Draws a box the size of the defined environemnt
Function makeEnvironment(XX,YY,ZZ)

makeEnvironment = Null

Dim arrCnrs(7)
arrCnrs(0) = Array(0,0,0)
arrCnrs(1) = Array(XX,0,0)
arrCnrs(2) = Array(XX,YY,0)
arrCnrs(3) = Array(0,YY,0)
arrCnrs(4) = Array(0,0,ZZ)
arrCnrs(5) = Array(XX,0,ZZ)
arrCnrs(6) = Array(XX,YY,ZZ)
arrCnrs(7) = Array(0,YY,ZZ)

rhino.addBox arrCnrs

End Function

lines.curveredraw.01

Option Explicit

Sub CurveRedraw()

Dim strObject,dblDegree,arrPoints,strCmd,arrPoint,i

strObject= Rhino.GetObject (“Select curve to redraw”,4)
If IsNull (strObject) Then Exit Sub
If Rhino.IsCurveClosed(strObject) Then
Rhino.Print “The object is a closed curve.”
Exit Sub
End If

arrPoints = Rhino.CurvePoints(strObject)
dblDegree = Rhino.CurveDegree(strObject)

Rhino.DeleteObject strObject
Dim strE
strE=” “
If IsArray(arrPoints) Then
For Each arrPoint In arrPoints
If i=UBound(arrPoints) Then strE=”"
strCmd=strCmd&”W”&Pt2str(arrPoint)&strE
Next
End If
Rhino.command “Curve Degree=”&CStr(dblDegree)&” “&strCmd, False

End Sub

CurveRedraw

lines.pline2curve.01

Option Explicit
Sub Poly2CrvMid ()

Dim arrCrvs,strCrv, arrPoints,arrPoint
Dim K,i,arrNPt,hh,kk

arrCrvs = Rhino.GetObjects(“Select curves”, 4)

If IsNull(arrCrvs) Then Exit Sub

ReDim arrCC(UBound(arrCrvs))

hh=0
For Each strCrv In arrCrvs
If Rhino.IsPolyline(strCrv) Then
arrPoints = Rhino.PolylineVertices(strCrv)

If IsArray(arrPoints) Then
k=UBound(arrPoints)
kk=(k+1)*2-2

ReDim arrNPt(kk)

Dim nn : nn=0

For i=1 To kk Step 2
arrNPt(i) = Array((arrPoints(nn)(0)+arrPoints(nn+1)(0))/2, (arrPoints(nn)(1)+arrPoints(nn+1)(1))/2, (arrPoints(nn)(2)+arrPoints(nn+1)(2))/2 )
nn=nn+1
Next
nn=0
For i=0 To kk Step 2
arrNPt(i) = arrPoints(nn)
nn=nn+1
Next

arrCC(hh) = Rhino.AddCurve (arrNPt ,3)
hh=hh+1

End If
End If
Next

Rhino.SelectObjects arrCC

End Sub

Poly2CrvMid

random.circles.01

Option Explicit

CirclesRnd

Sub CirclesRnd()

Dim x,y,R, arrPoint, UB,LB, R1,R2,arrPlane
Dim arrCircle, strCircle, intIndex, arrPObj

For x=0 To 100 Step 2

For y=0 To 10 Step 2

UB=3*x/30 : LB=-3*x/30 : R=Rnd*x/20
R1=(UB-LB+1)*Rnd+LB : R2=(UB-LB+1)*Rnd+LB

arrPoint = Array (x+R1,y+R2,R1)
arrPlane = Array (arrPoint, Array(1,0,0), Array(0,1,0), Array(0,0,1) )

If Not(R=0) Then
strCircle = Rhino.AddCircle (arrPlane, R)
arrCircle=Array(strCircle)
arrPObj = Rhino.AddPlanarSrf ( arrCircle )
intIndex = Rhino.ObjectMaterialIndex(arrPObj(0))
intIndex = Rhino.addMaterialToObject(arrPObj(0))
If (intIndex > -1) Then
Rhino.MaterialColor intIndex, Rhino.ColorHLSToRGB( Array((X+10)*1.5*Rnd, 125, 255) )
Rhino.MaterialTransparency intIndex, 0.6
End If
End If
Next
Next

End Sub