Option Explicit
'Script written by Luis Quinones
'Script copyrighted by
'Script version Saturday, August 01, 2009 9:56:59 AM
Call Main()
Sub Main()
'DECLATE ALL VARIABLE BY TYPE
Dim arrCrvs,arrCrvDiv
Dim gens
Dim i,j,k,L
Dim arrPtCoordinates,IndClosestCrv, arrcrvParam,crvPt,arrcrvPts()
Dim dist,count, vector, dblratio,NewPostion,AttThresh,compThresh
Dim newcurve,arrNewPos()
Dim arrCompAttract
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'INPUTS
'get curves
arrCrvs = Rhino.GetObjects("Select crvs",4)
'set generations
gens = Rhino.GetReal("Set Number of Gens / Steps")
compThresh = Rhino.GetReal("Set thresh for comp",3,0,1150)
AttThresh = Rhino.GetReal("Set Threshhold for line attractors",2,0,1159)
'amount for vector to move
dblratio = Rhino.GetReal("set distance for vector to move")
'very beginning of main
Dim arrItems : arrItems = Array ("Animate", "Off", "On")
Dim arrDefaults : arrDefaults = Array (True) 'off is the defaul
'in the beginning of main with other user inputs
Dim arrIterationBlnReturn : arrIterationBlnReturn = Rhino.GetBoolean ("Would you like to ", arrItems, arrDefaults)
If Not isArray(arrIterationBlnReturn) Then Exit Sub
'For exporting images
If arrIterationBlnReturn(0) = "True" Then
Dim intIterationsPerImage : intIterationsPerImage = Rhino.GetInteger ("export images once in how many iterations?", 1, 1)
If isNull (arrIterationBlnReturn) Then Exit Sub
'hardcoded variables:
'CHANGE THE FILE NAME TO AN EXISTING FOLDER - THE LAST PART IS THE BEGINNING OF THE FILE NAME
Dim strFilename : strFilename = "C:UsersEmergentDesktop"
Dim dblImageXSize : dblImageXSize = 968
Dim dblImageYSize : dblImageYSize = 462
Dim intImageCounter : intImageCounter = 0
'turn off unwanted screen info
Dim strView : strView = Rhino.CurrentView()
Rhino.ShowGrid strView, False
Rhino.ShowGridAxes strView, False
Rhino.ShowViewTitle strView, False
Rhino.ShowWorldAxes strView, False
Call exportImage(strFilename, dblImageXSize, dblImageYSize, strView, intImageCounter)
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Call Rhino.EnableRedraw(False)
'loops through generation
For i = 0 To gens
'looping through curves
For j = 0 To Ubound (arrCrvs)
arrCrvDiv = Rhino.CurvePoints (arrCrvs(j))
'looping through points of the current curve
For k = 0 To Ubound (arrCrvDiv)
Dim arrCompAttractStr : arrCompAttractStr = Rhino.ObjectsByLayer("Attract_Points_Comp")
Dim arrCheckPnt
For Each arrCheckPnt In arrCompAttractStr
If Not IsPoint(arrCheckPnt) Then
Rhino.TextOut "something in the (Attract_Points_Comp) layer is not points....its been deleted!"
Call Rhino.DeleteObject(arrCheckPnt)
'Call Rhino.Command("Sellayer")
End If
Next
'Rhino.Print (arrCompAttractStr(0))
arrCompAttract = arrCompAttractStr
Dim g
For g=0 To Ubound(arrCompAttractStr)
arrCompAttract(g) = Rhino.PointCoordinates(arrCompAttractStr(g))
Next
'set threshold for attractor
Dim IndClosestAtt : IndClosestAtt = Rhino.PointArrayClosestPoint(arrCompAttract,arrCrvDiv(k))
'storing the index of
Dim attPt : attPt = arrCompAttract(IndClosestAtt)
' distance between point and closest point on each curve (index)
Dim dist2 : dist2 = Rhino.Distance(attPt,arrCrvDiv(k))
'is that distance less than
If dist2 < compThresh Then
NewPostion = attPt
Else
count = 0
'looping through the curves to find closest point
For L = 0 To Ubound(arrCrvs)
'you need to check the closest curve from each point (except yourself)
If Not j = L Then
arrcrvParam = Rhino.CurveClosestPoint(arrCrvs(L),arrCrvDiv(k))
crvPt = Rhino.EvaluateCurve(arrCrvs(L),arrcrvParam)
ReDim Preserve arrcrvPts(count)
arrcrvPts(count) = crvPt
count = count + 1
End If
Next
'find closest point
IndClosestCrv = Rhino.PointArrayClosestPoint(arrcrvPts,arrCrvDiv(k))
crvPt = arrcrvPts(IndClosestCrv)
' distance between point and closest point on each curve (index)
dist = Rhino.Distance(arrCrvDiv(k), crvPt)
'compare distance to threshold
If dist < AttThresh Then
'create vector using index of the closest pt and array of control point(s)
vector = Rhino.VectorCreate(crvPt,arrCrvDiv(k))
vector = Rhino.VectorScale(vector,dblratio)
NewPostion = Rhino.VectorAdd(vector,arrCrvDiv(k))
Else
'however if distance > threshold then the NEWPOSITION will be the previous POSITION.
NewPostion = arrCrvDiv(k)
End If
End If
ReDim Preserve arrNewPos(k)
'make array of new point positions to use for drawing curve
arrNewPos(k) = NewPostion
Next
newcurve = Rhino.AddCurve(arrNewPos,3)
Call Rhino.DeleteObject(arrCrvs(j))
arrCrvs(j) = newcurve
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If arrIterationBlnReturn(0) = "True" Then
If i Mod intIterationsPerImage = 0 Then
intImageCounter = intImageCounter + 1
Call exportImage(strFilename, dblImageXSize, dblImageYSize, strView, intImageCounter)
End If
End If
Next
Next
' Call Rhino.EnableRedraw(True)
End Sub
Sub exportImage(strFilename, dblImageXSize, dblImageYSize, strView, intIteration)
Dim strNumber
'create a number for the image, additional zeros are added to ensure the files are read in the correct order by photoshop batch actions
If intIteration < 9 Then
strNumber = "000" & (intIteration + 1)
ElseIf intIteration > 8 And intIteration < 99 Then
strNumber = "00" & (intIteration + 1)
ElseIf intIteration > 98 And intIteration < 999 Then
strNumber = "0" & (intIteration + 1)
Else
strNumber = intIteration + 1
End If
'send the image to an appropriately named file
Rhino.CreatePreviewImage strFilename & strNumber & ".png", strView, array(dblImageXSize, dblImageYSize), ,True
End Sub
Update
