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

rh_PhyTower wip01

The code will be available soon...

rh_Object scale, shade color and material from an attractor point

I wrote these scripts for testing the use of distance value from a group of object to one attractor to define the scale of objects themselves, color shade and material color. It's just for fun and for exercise with VBrhinoscript.

Download attractor.rvb

Option Explicit

'this script plays with an attractor point

'Script written by davide del giudice

'Script copyrighted by co-de-it

MsgBox "Code by Davide del Giudice www.Co-de-iT.com"

Call Main()

Sub Main()

Dim arrpts, arrpt,arrNormal

Dim i,u

Dim dbdist,strline1,arrPlane,circle

'select a grid of points

arrpts = Rhino.GetPointCoordinates ("Select grid of points",1)

'select an attractor

arrpt= Rhino.GetPointCoordinates ("Select attractor")

If IsNull (arrpts) Then

Exit Sub

If IsNull (point) Then

Exit Sub

End If

End If

'loop for the grid of points

For i= 0 To Ubound (arrpts)

'loop for the attractor

For u = 0 To UBound (arrpt)

'calculates the distance between every points to the attractor

dbdist = Rhino.Distance (arrpts(i), arrpt(u))

'draws one line from i-point and the attractor

strline1=Rhino.AddLine (arrpts(i), arrpt(0))

'defines the shade color of the line

Rhino.ObjectColor strline1, rgb (dbdist*6,dbdist*15,100)

'calculates a vector from i-point and the attractor

arrNormal = Rhino.VectorCreate (arrpts (i), arrpt(0))

arrPlane=Rhino.PlaneFromNormal(arrpts(i), arrNormal)

circle= rhino.AddCircle (arrPlane, dbdist/10)

Dim planarsrf

planarsrf= Rhino.AddPlanarSrf (array(circle))

Rhino.ObjectColor planarsrf, rgb (dbdist*6,dbdist*15,100)

'defines the material of the planar surface

Dim material

material = rhino.AddMaterialToObject ( planarsrf(0))

Call rhino.MaterialColor (material, rgb (dbdist*6,dbdist*15,100))

Call rhino.MaterialShine (material, 255)

Next

Next

End Sub

Download U&V normal.rvb

Option Explicit

MsgBox "Code by Davide del Giudice www.Co-de-iT.com"

Call ArrayPointsOnSurface()

Sub ArrayPointsOnSurface()

Dim strObject, nRows, nColumns,strpt,oript,arrplane,arrplane2, strLoftSRF

Dim U, V, i, j, arrParam(1), arrPoint,endpt,pts,arrClosest,arrNormal,Line,d2,pt,plane,circle,circle2

' Get the surface object

strObject = Rhino.GetObject("Select surface", 8)

oript= rhino.GetObject("pickpoint",1)

strpt= rhino.pointcoordinates(oript)

If IsNull(strObject) Then Exit Sub

' Get the number of rows

nRows = Rhino.GetInteger("Number of rows", 20, 2)

If IsNull(nRows) Then Exit Sub

nRows = nRows - 1

' Get the number of columns

nColumns = Rhino.GetInteger("Number of columns", 20, 2)

If IsNull(nColumns) Then Exit Sub

nColumns = nColumns - 1

' Get the domain of the surface

U = Rhino.SurfaceDomain(strObject, 0)

V = Rhino.SurfaceDomain(strObject, 1)

If Not IsArray(U) Or Not IsArray(V) Then Exit Sub

' Add the points

For i = 0 To nRows

arrParam(0) = U(0) + (((U(1) - U(0)) / nRows) * i)

For j = 0 To nColumns

arrParam(1) = V(0) + (((V(1) - V(0)) / nColumns) * j)

arrPoint = Rhino.EvaluateSurface(strObject, arrParam)

If IsArray(arrPoint) Then

arrClosest = Rhino.SurfaceClosestPoint(strObject, arrPoint)

arrNormal = Rhino.SurfaceNormal(strObject, arrParam)

Rhino.Print Rhino.Pt2Str(arrNormal)

endpt=rhino.vectoradd(arrpoint,arrNormal)

Line= rhino.addline (arrpoint,endpt)

d2=rhino.Distance (arrpoint,strpt)

arrPlane= Rhino.PlaneFromNormal (arrPoint, arrNormal)

arrPlane2= Rhino.PlaneFromNormal (endpt, arrNormal)

circle=Rhino.AddCircle (arrPlane, d2/50)

circle2=Rhino.AddCircle (arrPlane2, d2/100)

Dim material

strLoftSRF=Rhino.AddLoftSrf (array(circle,circle2))

material = rhino.AddMaterialToObject (strLoftSRF(0))

Call rhino.MaterialColor (material, rgb (d2*3,d2*5,150))

Call rhino.MaterialShine (material, 255)

Call rhino.ObjectColor (Line, rgb (d2*3,d2*5,150) )

Call rhino.ObjectColor (circle, rgb (d2*3,d2*5,150) )

Call rhino.ObjectColor (circle2, rgb (d2*3,d2*5,150) )

Call rhino.ObjectColor (strLoftSRF, rgb (d2*3,d2*5,150) )

End If

Next

Next

rhino.HideObject strobject

End Sub

Porous structure///

Testing Daniel Piker' s kangaroo component.