Option Explicit 'Script written by Luis Quinones 'Script copyrighted by [n]igma + studioBoom 'www.luisquinonesdesign.com 'www.cargocollective.com/studioboom '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("Attractors") 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