Colors From Attractors

Paint Objects Colors & Material By Distance From R, G, B Attractors

Option Explicit
'Script written by Ezio Blasetti
'Script copyrighted by algorithmicdesign.net
'Script version Tuesday, February 08, 2011 4:29:33 PM
Call Main()
Sub Main()
'ask the user to select the components (objects) to paint
Dim arrObjects : arrObjects = Rhino.GetObjects("please select the objects to paint")
'get all the point and curve OBJECTS from the layer "R","G","B" and store them in arrays
Dim arrAttrR : arrAttrR = PointsAndCrvsFromLayer("R")
Dim arrAttrG : arrAttrG = PointsAndCrvsFromLayer("G")
Dim arrAttrB : arrAttrB = PointsAndCrvsFromLayer("B")
Dim i
If IsArray(arrAttrR) Then
ReDim arrAttrRDists(Ubound(arrAttrR))
For i=0 To Ubound(arrAttrR)
arrAttrRDists(i) = GetMinAndMaxDistanceToAttrFromObjects(arrAttrR(i),arrObjects)
Next
End If
If IsArray(arrAttrG) Then
ReDim arrAttrGDists(Ubound(arrAttrG))
For i=0 To Ubound(arrAttrG)
arrAttrGDists(i) = GetMinAndMaxDistanceToAttrFromObjects(arrAttrG(i),arrObjects)
Next
End If
If IsArray(arrAttrB) Then
ReDim arrAttrBDists(Ubound(arrAttrB))
For i=0 To Ubound(arrAttrB)
arrAttrBDists(i) = GetMinAndMaxDistanceToAttrFromObjects(arrAttrB(i),arrObjects)
Next
End If
'loop through your (objects)
Dim k, dblDistance
For i=0 To Ubound(arrObjects)
Dim Rvalue : Rvalue = 0
Dim Gvalue : Gvalue = 0
Dim Bvalue : Bvalue = 0
If IsArray(arrAttrR) Then
Rvalue = Get0_255ValueFromDist2Attractors(arrAttrR, arrAttrRDists, arrObjects(i))
End If
If IsArray(arrAttrG) Then
Gvalue = Get0_255ValueFromDist2Attractors(arrAttrG, arrAttrGDists, arrObjects(i))
End If
If IsArray(arrAttrB) Then
Bvalue = Get0_255ValueFromDist2Attractors(arrAttrB, arrAttrBDists, arrObjects(i))
End If
Call Rhino.ObjectColor (arrObjects(i), RGB(Rvalue,Gvalue,Bvalue))
Dim intIndex : intIndex = Rhino.AddMaterialToObject (arrObjects(i))
Call Rhino.MaterialColor (intIndex , RGB(Rvalue,Gvalue,Bvalue))
Next
End Sub

Function CenterOfBoundingBox(arrObjects)
Dim arrBBox : arrBBox = Rhino.BoundingBox (arrObjects)
Dim XofCenter : XofCenter = (arrBBox(0)(0) + arrBBox(1)(0))/2
Dim YofCenter : YofCenter = (arrBBox(0)(1) + arrBBox(3)(1))/2
Dim ZofCenter : ZofCenter = (arrBBox(0)(2) + arrBBox(4)(2))/2
CenterOfBoundingBox = array( XofCenter, YofCenter, ZofCenter)
End Function

Function PointsAndCrvsFromLayer(strLayer)
PointsAndCrvsFromLayer = Null
Dim arrObjects : arrObjects = Rhino.ObjectsByLayer (strLayer)
If IsArray(arrObjects) Then
'define a new variable (array) dynamic with size -1
ReDim arrReturn(-1)
Dim i
'loop through all the Ids of the objects
For i=0 To Ubound(arrObjects)
If Rhino.Ispoint(arrObjects(i)) Then
ReDim Preserve arrReturn(Ubound(arrReturn)+1)
arrReturn(Ubound(arrReturn)) = arrObjects(i)
ElseIf Rhino.IsCurve(arrObjects(i)) Then
ReDim Preserve arrReturn(Ubound(arrReturn)+1)
arrReturn(Ubound(arrReturn)) = arrObjects(i)
End If
' end the loop
Next
PointsAndCrvsFromLayer = arrReturn
End If
End Function

Function GetMinAndMaxDistanceToAttrFromObjects(strAttr,arrObjects)
GetMinAndMaxDistanceToAttrFromObjects = Null
'If Not Rhino.IsPoint(strAttr) Or Rhino.IsCurve(strAttr) Then Exit Function
If Not IsArray(arrObjects) Then Exit Function

Dim dblMinDistance : dblMinDistance = 5000000
Dim dblMaxDistance : dblMaxDistance = -1
Dim i
For i=0 To Ubound(arrObjects)
Dim dblDistance
If Rhino.IsPoint(strAttr) Then
dblDistance = Rhino.Distance(CenterOfBoundingBox(arrObjects(i)),Rhino.PointCoordinates(strAttr))
Else
Dim dblParam : dblParam = Rhino.CurveClosestPoint(strAttr, CenterOfBoundingBox(arrObjects(i)))
dblDistance = Rhino.Distance(CenterOfBoundingBox(arrObjects(i)),Rhino.EvaluateCurve(strAttr,dblParam))
End If

If dblDistance < dblMinDistance Then
dblMinDistance = dblDistance
End If
If dblDistance > dblMaxDistance Then
dblMaxDistance = dblDistance
End If
Next
GetMinAndMaxDistanceToAttrFromObjects = array(dblMinDistance,dblMaxDistance)
End Function

Function Get0_255ValueFromDist2Attractors(arrAttrs, arrMinMaxDist, strObject)
Get0_255ValueFromDist2Attractors = Null
Dim intReturn : intReturn = 0
Dim arrCenter : arrCenter = CenterOfBoundingBox(strObject)
Dim i
For i=0 To Ubound(arrAttrs)
Dim dblDistance
If Rhino.IsPoint(arrAttrs(i)) Then
dblDistance = Rhino.Distance(arrCenter,Rhino.PointCoordinates(arrAttrs(i)))
Else
Dim dblParam : dblParam = Rhino.CurveClosestPoint(arrAttrs(i), arrCenter)
dblDistance = Rhino.Distance(arrCenter,Rhino.EvaluateCurve(arrAttrs(i),dblParam))
End If
intReturn = intReturn + ((arrMinMaxDist(i)(1)-dblDistance)/(arrMinMaxDist(i)(1)-arrMinMaxDist(i)(0)))*255
Next
intReturn = intReturn/(Ubound(arrAttrs)+1)
Get0_255ValueFromDist2Attractors = intReturn
End Function