rh color scale attractor

This script apply a gradient color and scales an array of objects.


Option Explicit
Call Main()
Sub Main()
Dim object,attr,bottles,attr1,points,i,arrpoints
bottles= rhino.getobjects (" select bottles")

attr=rhino.getobject (" select attractor",1)
attr1=Rhino.PointCoordinates(attr)
For i=0 To Ubound(bottles)


object=rhino.surfaceVolumecentroid (bottles(i))

Dim dist:dist= rhino.distance ( object(0), attr1)

Dim material5

material5 = rhino.AddMaterialToObject ( bottles(i))
Call rhino.MaterialColor (material5, rgb((dist*100)+10,(dist*30),(dist*60)+10))
Call rhino.MaterialShine (material5, 255)
Call rhino.ScaleObject (bottles(i),object(0),array(dist*0.5,dist*0.5,dist*0.5),False)
Next

End Sub

rh If Then Else

Very simple rhinoscript to understand the "If then else" logic.

Option Explicit
'Script written by davide del giudice
'Script copyrighted by www.co-de-it.com
'Script version lunedì 17 ottobre 2011 16.52.36
Call IfThenElse()
Sub IfThenElse()

Dim arrpointsA,arrpointsB,i,arrA,arrB
arrpointsA=rhino.GetObjects ("select points A",1)
arrpointsB=rhino.GetObjects("select points B",1)



For i=0 To Ubound (arrpointsA)


arrA= Rhino.PointCoordinates (arrpointsA(i))
arrB= Rhino.PointCoordinates (arrpointsB(i))

Dim distance:distance= rhino.distance (arrA,arrB)
If rhino.Distance( arrA, arrB)<4 Then
Dim sphere1:sphere1=rhino.addsphere (arrB,1)
Call rhino.ObjectColor (sphere1, rgb(50,125,50))
Else
Dim sphere2:sphere2= rhino.AddSphere (arrB,1.5)
Call rhino.ObjectColor (sphere2, rgb(150,200,150))
End If

Next
End Sub

rh in progress

New rhinoscript coming soon: seed tesselationreptile skin

recursive subdivision

rh UnrollSrfs

This is yet another unroll rhinoscript.
Download the rhino file and .rvb here

----------

Option Explicit

'Script written by davide del giudice

'Script copyrighted by www.co-de-it.com

'Script version Saturday, 09 Oct 2011

Call UnrollSrfs()

Sub UnrollSrfs()

Dim arrsrf

arrsrf=rhino.GetObjects("select surfaces",8+16)

Call unroll(arrsrf)

End Sub

Function unroll(arrsrf)

Dim i,arrUnrolledObj,counter,counter2

ReDim arrUnrolledObj(UBOUND(arrsrf))

counter=0

counter2=0

For i=0 To UBound(arrsrf)

Call Rhino.SelectObject(arrsrf(i))

Dim arrmp:arrmp= rhino.SurfaceAreaCentroid (arrsrf(i))

Dim area1:area1= rhino.surfacearea (arrsrf(i))

Dim area:area=Rhino.Ceil ((area1(0)/100))

Dim dot:dot= rhino.AddTextDot ("n#"&counter, arrmp(0))

Call rhino.ObjectColor (dot, rgb (((counter*10)+10),((counter*10)+50),((counter*10)+50)))

Rhino.Command "_Unrollsrf explode=no enter"

Call Rhino.UnselectAllObjects

arrUnrolledObj(i) = Rhino.FirstObject

Dim centroid:centroid=Rhino.SurfaceAreaCentroid (arrUnrolledObj(i))

If i

rhino.addpoint array(counter*100,50,0)

Call rhino.MoveObject (arrUnrolledObj(i),centroid(0),array(counter*100,50,0))

Dim txt2:txt2=rhino.AddText ("n"&counter&"_"&area&"cmq",array(counter*100,50,0),6)

Call rhino.ObjectColor (txt2, rgb (0,0,255))

Else

rhino.addpoint array(counter2*100,-100,0)

Call rhino.MoveObject (arrUnrolledObj(i),centroid(0),array(counter2*100,-100,0))

Dim txt4:txt4=rhino.AddText ("n"&counter&"_"&area&"cmq",array(counter2*100,-100,0),6)

Call rhino.ObjectColor (txt4, rgb (0,0,255))

counter2=counter2+1

End If

Dim arredge:arrEdge = Rhino.DuplicateEdgeCurves(arrUnrolledObj(i))

Call Rhino.JoinCurves(arrEdge,True)

Call Rhino.DeleteObject(arrUnrolledObj(i))

counter=counter+1

Next

End Function

---------

rh TowerContour

This script creates planar surfaces and puts a tag with the area value for each floor of the tower.

Download rhino file and contour.rvb

Option Explicit

'Script written by davide del giudice

'Script copyrighted by www.co-de-it.com

'Script version Saturday, 09 Oct 2011

Call Contour()

Sub Contour()

Dim srf1,arrcrvs,startpt,endpt,arrst,arrend, int,crv,counter,counter2

srf1=rhino.GetObject("select surface",8+16)

int= rhino.GetInteger ("select height floor",10,1,100)

startpt=rhino.getobject("select start point",1)

endpt=rhino.Getobject("select end point",1)

arrst=rhino.PointCoordinates (startpt)

arrend=rhino.PointCoordinates (endpt)

arrcrvs=Rhino.AddSrfContourCrvs (srf1, arrst, arrend,int)

rhino.HideObject srf1

counter=0

counter2=0

For Each crv In arrcrvs

If rhino.iscurveclosed(crv) Then

Dim centroid:centroid=Rhino.CurveAreaCentroid (crv)

Dim area:area=rhino.curveArea (crv)

Call rhino.ObjectColor (crv, rgb (((counter*10)+50),((counter*10)+50),((counter*10)+50)))

Dim area1:area1=Rhino.Ceil (area(0))

Dim arrBox:arrBox=Rhino.BoundingBox (crv)

Dim arrpoint

Dim dot:dot= rhino.AddTextDot ("floor#"&counter, arrBox(3))

Dim plansrf:plansrf=rhino.AddPlanarSrf (array(arrcrvs(counter)))

Call rhino.ObjectColor (plansrf, rgb (((counter*10)+50),((counter*10)+50),((counter*10)+50)))

Call rhino.ObjectColor (dot, rgb (((counter*10)+10),((counter*10)+50),((counter*10)+50)))

If counter

rhino.addpoint array(counter*50,0,0)

Call rhino.MoveObject (crv,centroid(0),array(counter*50,50,0))

Dim txt1:txt1=rhino.AddText ("A"&counter&"_"&area1&"mq",array(counter*50,0,0),5)

Dim txt3:txt3=rhino.AddText ("n"&counter,array(counter*50,50,0),5)

Call rhino.ObjectColor (txt1, rgb (((counter*10)+50),((counter*10)+50),((counter*10)+50)))

Call rhino.ObjectColor (txt3, rgb (((counter*10)+50),((counter*10)+50),((counter*10)+50)))

Else

rhino.addpoint array(counter2*50,-150,0)

Call rhino.MoveObject (crv,centroid(0),array(counter2*50,-100,0))

Dim txt2:txt2= rhino.AddText ("A"&counter&"_"&area1&"mq",array(counter2*50,-150,0),5)

Dim txt4:txt4= rhino.AddText ("n"&counter,array(counter2*50,-100,0),5)

Call rhino.ObjectColor (txt2, rgb (((counter*10)+50),((counter*10)+50),((counter*10)+50)))

Call rhino.ObjectColor (txt4, rgb (((counter*10)+50),((counter*10)+50),((counter*10)+50)))

counter2=counter2+1

End If

End If

counter=counter+1

Next

End Sub