17 October 2011

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

14 October 2011

rh in progress

New rhinoscript coming soon: seed tesselationreptile skin
recursive subdivision

09 October 2011

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
---------

08 October 2011

rh TowerContour

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

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