Saturday, November 22, 2008

finding form through attractions and repulsioin





Option Explicit
'Script written by
'Script version Wednesday, November 19, 2008 12:04:14 AM
'======================================================================================================================================
'Notes
'======================================================================================================================================
Call attraction_v5
Sub attraction_v5()
'variables to be used
Dim arrObject, arrAttract, arrAttPt, arrAttDist,arrObjPt,arrClosestGripPoint
Dim Counter, i, j, thresholdDist,dblClosestAttDist, dblClosestAtt, dblAttDistTest,adjAmount,adjAmountZ,intRebuild,adjI
'===================================================================================================================================
'Start Assigning Values
arrObject = Rhino.GetObjects(" Please Choose Objects to Manipulate")
arrattract = Rhino.GetObjects("Please Choose Object to Use as 'Attractor'",1)
'===if you require multiple threshold distances then --please select the points in the order you want the thresholds assigned=====
'thresholdDist = Multi_T_Dist(arrAttract)
'============If you require only one threshold distance then======================================================================
thresholdDist = Rhino.GetReal("Please Select A Radius to Affect",1000,10,10000)
'==================================================================================================================================
intRebuild = Rhino.GetInteger("Please Choose a Rebuild Number",3,2,50)
'adjI = Rhino.GetReal("Please Select index for addjust amount",0.1,0.1,1.0)
'===================================================================================================================================
'Enable all object grips
arrObjPt = GetAGrip(arrobject,IntRebuild)
'Call LableAttractors (arrattract)
'===================================================================================================================================
'Rhino.EnableRedraw(False)
For i = 0 To Ubound(arrObjPt)
counter = 0
For j = 0 To Ubound(arrattract)
arrAttPt= Rhino.PointCoordinates(arrAttract(j))
' get distance
dblAttDistTest = Rhino.Distance(arrAttPt, arrobjPt(i)(2))
' is it closer
If counter < 1 Then
dblClosestAttDist = dblAttDistTest
dblClosestAtt = counter
Else
'====== for multiple attractor thresholds====================================================================
'If dblAttDistTest < thresholdDist(j) Then
'====================if single attractor threshold==========================================================
If dblAttDistTest < thresholdDist Then
'=======================================================================================================
If dblAttDistTest < dblClosestAttDist Then
dblClosestAttDist = dblAttDistTest

dblClosestAtt = counter
End If
End If
End If
counter = counter + 1
Next
j = j-1
'====================================== for multiple attractor thresholds==============================================
'If dblClosestAttDist < thresholdDist(j) Then
'====================================== for single attractor thresholds================================================
If dblClosestAttDist < thresholdDist Then
'=============================================== caculate the adjustment amount====================================
'==================================================================================================================
'================== If required action is Bunching Uncomment the line below========================================
Rhino.ObjectGripLocation arrObjPt(i)(0),arrObjpt(i)(1),arrAttPt
'===================If required action is Repulsion Uncomment the line below=======================================
'adjAmount = array(((arrObjPt(i)(2)(0)-arrAttPt(0))*adjI)+arrAttPt(0),((arrObjPt(i)(2)(1)-arrAttPt(1))*adjI)+arrAttPt(1),((arrObjPt(i)(2)(2)-arrAttPt(2))*adjI)+arrAttPt(2))
'Rhino.ObjectGripLocation arrObjPt(i)(0),arrObjpt(i)(1),adjAmount
'==================================================================================================================
'adjAmountZ = arrobjPt(i)(2)(0)*adjIndex
'adjAmount = array((arrObjPt(i)(2)(0)*adjIndex)+arrobjPt(i)(2)(0),(arrObjPt(i)(2)(1)*adjIndex)+arrobjPt(i)(2)(1),(arrObjPt(i)(2)(2)*adjIndex)+arrobjPt(i)(2)(2))
'Rhino.ObjectGripLocation arrObjPt(i)(0),arrObjpt(i)(1),array(arrObjpt(i)(2)(0)+adjAmount(0),arrObjpt(i)(2)(1)+adjAmount(1),arrObjpt(i)(2)(2)+adjAmountZ)
'===================================================================================================================
'adjAmount2 = (((dblClosestAttDist/thresholdDist)*100 )-(thresholdDist/2))
'move grips
'For Bunching ie all points move to the attractor location
'Rhino.ObjectGripLocation arrObjPt(i)(0),arrObjpt(i)(1),arrAttPt
'Rhino.ObjectGripLocation arrObjPt(i)(0),arrObjpt(i)(1), array(arrObjpt(i)(2)(0)- adjAmount,arrObjpt(i)(2)(1)+adjAmount,adjAmount2)
'For Repelling ie all points move away from attractor location
'Rhino.ObjectGripsLocations
'Rhino.EnableObjectGrips arrobject(i),False

End If
Next
Call turnOff(arrObject)
'Rhino.EnableRedraw(True)
End Sub
Function GetAGrip(objects,Segments)
Dim i,arrObjGrips(),arrIndex(),arrLoc()
Rhino.EnableRedraw(False)
For i = 0 To Ubound(objects)
'==========Use this for Curves============
Rhino.RebuildCurve objects(i),3,segments
'==========Use this for surfaces==========
'Rhino.RebuildSurface objects(i),array(3,3),Array(segments,segments)
'===========Get Control Points============
Rhino.ObjectGripsOn(objects(i))
Rhino.EnableObjectGrips objects(i),True
Rhino.SelectObjectGrips(objects(i))
ReDim Preserve arrObjGrips(i)
arrObjGrips(i) = Rhino.GetObjectGrips(objects(i),True)
Next
'=======Store Last index of arrObjGrips======
i = i - 1
GetAGrip = arrObjGrips(i)
Rhino.EnableRedraw(True)
End Function
Function TurnOff(objects)
Dim i
For i = 0 To ubound(objects)
Rhino.EnableObjectGrips objects(i),False
Next
End Function
Function LableAttractors(strObject)
Dim arrpoint,i
For i = 0 To Ubound(strObject)
arrpoint = Rhino.PointCoordinates(strObject(i))
Rhino.AddTextDot strObject(i), arrPoint
Next

End Function
Function Multi_T_Dist(attractor)
Multi_T_Dist = 1000
Dim i,arrTdist()
For i = 0 To Ubound(attractor)
ReDim Preserve arrTdist(i)
arrTdist(i) = Rhino.RealBox("Please Give me a threshold distance for this attractor",1000,"Insert threshold Distance")
Next
i = i-1
Multi_T_Dist = arrTdist
End Function