diG.T.A

L-system [test]

2009-11-02T20:04:00.007+01:00

Working on the same principles of my last post I realized a new script based on self-learning system.
The concept is easy. A simple L-system start to grown randomly from a seed, and after every generation it try to touch other L-systems, that are growing from different one seed.

[edit]
I forgot to explain some aspects. In this script singles L-system recive a feedback from others, because configuration of every generation depend on configuration of previous one.
Unlike my previous script there isn't only one final perfect configuration, but infinity ones... because every random event of system "A" affects other systems in next generation, thus itself in following one.
[/edit]

Option Explicit
' Script written by Alessandro Zomparelli
' alessandro.zomparelli@gmail.com
' http://alessandrozompa.altervista.org/
' Script version domenica 1 novembre 2009 14.40.18

Call Main()
Sub Main()
'picking seed points
Dim arrSeed, arrSub
ReDim arrSeed(0)
arrSeed(0)=Rhino.GetObjects("pick seed points",1)

'defining number of branch
Dim dblBrN
dblBrN=Rhino.GetInteger("number of branches",2,1)

'defining number of branch generation
Dim dblBranch
dblBranch=Rhino.GetInteger("number of branch generation",3,1)
ReDim Preserve arrSeed(dblBranch)

Dim arrData, dblVote, arrVote
ReDim arrData(dblBranch), arrVote(0)

'defining number of generations and amount of mutation between following generations
Dim dblGen, dblMut, strLine
dblGen=Rhino.GetInteger("set number of generations",100,2,10000)
dblMut=Rhino.GetReal("set mutation value",2,0.1,100)

Call Rhino.EnableRedraw(False)

'starting evolution system
Dim i,j,z,k,y,m,a

Dim dblDis, arrDist, strC1, strC2
ReDim arrDist(0)

'generation of different layers
Dim strL1: strL1="lines"
Call Rhino.AddLayer(strL1)

'evaluation of distance between seed points for a better L-System scale
dblDist=Rhino.Distance(Rhino.PointCoordinates(arrSeed(0)(0)),Rhino.PointCoordinates(arrSeed(0)(1)))
For i=0 To ubound(arrSeed(0))
For j=0 To ubound(arrSeed(0))
If i<>j Then
If Rhino.Distance(Rhino.PointCoordinates(arrSeed(0)(i)),Rhino.PointCoordinates(arrSeed(0)(j)))<>0 Then
arrSeed(i)=arrSub
End If
arrData(i)=arrSub
For j=0 To ubound(arrSeed(i))
arrData(i)(j)=array(0,array(0,0,0),array(0,0,0),dblDis)
Next
Next

For z=0 To dblGen-1
Call Rhino.Print(int(z*100/(dblGen-1))&"%")
For i=1 To dblBranch
'generation of branches
For j=0 To ubound(arrSeed(i-1))

For y=0 To dblBrN-1
'defining vector scattering direction
arrData(i)(j*(dblBrN)+y)(2)=array(arrData(i)(j*(dblBrN)+y)(1)(0)+dblMut*(dblGen-z)/dblGen*(rnd-rnd),arrData(i)(j*(dblBrN)+y)(1)(1)+dblMut*(dblGen-z)/dblGen*(rnd-rnd),arrData(i)(j*(dblBrN)+y)(1)(2)+dblMut*(dblGen-z)/dblGen*(rnd-rnd))

'propotional scaling factor
arrData(i)(j*(dblBrN)+y)(2)=Rhino.VectorUnitize(arrData(i)(j*(dblBrN)+y)(2))
arrData(i)(j*(dblBrN)+y)(2)=Rhino.VectorScale(arrData(i)(j*(dblBrN)+y)(2),arrData(i)(j*(dblBrN)+y)(3)/i/3)
arrSeed(i)(j*(dblBrN)+y)=Rhino.CopyObject(arrSeed(i-1)(j),arrData(i)(j*(dblBrN)+y)(2))

'drawing last generation
If z=dblGen-1 Then
strLine=Rhino.AddLine(Rhino.PointCoordinates(arrSeed(i-1)(j)),Rhino.PointCoordinates(arrSeed(i)(j*(dblBrN)+y)))
Call Rhino.objectlayer(strLine,strL1)
If i=1 Then
strC1=Rhino.AddCircle(Rhino.PlaneFromNormal(Rhino.PointCoordinates(arrSeed(i-1)(j)),arrData(i)(j*(dblBrN)+y)(2)),arrData(i-1)(j)(3)/20/i)
Else
strC1=Rhino.AddCircle(Rhino.PlaneFromNormal(Rhino.PointCoordinates(arrSeed(i-1)(j)),arrData(i)(j*(dblBrN)+y)(2)),arrData(i-1)(j)(3)/40/(i-1))
End If
strC2=Rhino.AddCircle(Rhino.PlaneFromNormal(Rhino.PointCoordinates(arrSeed(i)(j*(dblBrN)+y)),arrData(i)(j*(dblBrN)+y)(2)),arrData(i)(j*(dblBrN)+y)(3)/40/i)
Call Rhino.AddLoftSrf(array(strC1,strC2))
If i=1 Then
Call Rhino.AddSphere(Rhino.PointCoordinates(arrSeed(i-1)(j)),arrData(i-1)(j)(3)/20/i)
'Else
' Call Rhino.AddSphere(Rhino.PointCoordinates(arrSeed(i-1)(j)),arrData(i-1)(j)(3)/30/(i-1))
End If
Call Rhino.AddSphere(Rhino.PointCoordinates(arrSeed(i)(j*(dblBrN)+y)),arrData(i)(j*(dblBrN)+y)(3)/40/i)
Call Rhino.DeleteObjects(array(strC1,strC2))
End If

'for display colors of different generation
'If z/10=int(z/10) Then
' strLine=Rhino.AddLine(Rhino.PointCoordinates(arrSeed(i-1)(j)),Rhino.PointCoordinates(arrSeed(i)(j*2+y)))
' Call Rhino.ObjectColor(strLine, RGB(255-255/dblGen*z,0,255/dblGen*z))
'End If
Next
Next

'recordn data of individual branches
For j=0 To ubound(arrSeed(i-1))
For y=0 To dblBrN-1
a=-1
'defining votes for branches generated from different seeds
For k=0 To ubound(arrSeed(i-1))
If int(k/(dblBrN^(i-1)))<>int(j/(dblBrN^(i-1))) Then
For m=0 To dblBrN-1
a=a+1
ReDim Preserve arrVote(a), arrDis(a+1)
'defining a vote for element efficiency
arrVote(a)=(Rhino.Distance(PointCoordinates(arrSeed(i-1)(j)),Rhino.PointCoordinates(arrSeed(i-1)(k)))-Rhino.Distance(Rhino.PointCoordinates(arrSeed(i)(j*(dblBrN)+y)),Rhino.PointCoordinates(arrSeed(i-1)(k))))
'recording distance from detected points
arrDist(a)=Rhino.Distance(PointCoordinates(arrSeed(i-1)(j)),Rhino.PointCoordinates(arrSeed(i-1)(k)))
Next
End If
Next
dblVote=Rhino.Max(arrVote)

'recording dist for nearest point
For k=0 To ubound(arrVote)
If arrVote(k)=dblVote Then
arrDist(a+1)=arrDist(k)
End If
Next

'recording data about the new element
If dblVote>arrData(i)(j*(dblBrN)+y)(0) Then
arrData(i)(j*(dblBrN)+y)(0)=dblVote
arrData(i)(j*(dblBrN)+y)(1)=arrData(i)(j*(dblBrN)+y)(2)
arrData(i)(j*(dblBrN)+y)(3)=arrDist(a+1)
End If
Next
Next

Next
For i=1 To dblBranch
Call Rhino.DeleteObjects(arrSeed(i))
Next

Next
Call Rhino.LayerVisible(strL1,False)
Call Rhino.EnableRedraw(True)
Call Rhino.Print("100%")

End Sub

it's evolution, baby!

2009-10-31T17:52:00.016+01:00

The purpose of this script is twofold: to study emergent systems based on simple elements, and to build a code for a self-learning system.

Imagin a family of worms sorted on a path. Every worm move randomly from previous one. This worm recive a vote based on approach to the target specified.
Coding this script I follow a very simple rule: worms that gain better vote may proliferate replacing themselves in next generations.
Every generation manifest mutation like in Darwin's theory of evolution, and environment rules define if this mutations are good or not for species.

Like human body and ant colony, later generations reduce scattering for a more accurate configuration. Studying countless generations, the family should reach the target specified.

Specifying different rules for worms should be possible to study emergent systems whose behavior is not predictable from the study of individual elements, like organic complexity L-systems.

Option Explicit
' Script written by Alessandro Zomparelli
' alessandro.zomparelli@gmail.com
' http://alessandrozompa.altervista.org/
' Script version venerdì 30 ottobre 2009 16.59.03

Call Main()
Sub Main()
Dim strTarget, arrFamily, arrTarget, n
n=Rhino.GetInteger("set number elements",20,2,100)

ReDim arrFamily(n), arrTarget(2)
arrFamily(0)=Rhino.GetObject("pick starting point")
'check for starting point
If Rhino.IsPoint(arrFamily(0))=False Then
Exit Sub
End If
strTarget=Rhino.GetObject("pick target point")
'check for target point
If Rhino.IsPoint(strTarget)=False Then
Exit Sub
End If
arrTarget=Rhino.PointCoordinates(strTarget)

Dim dblDist
dblDist=Rhino.Distance(Rhino.PointCoordinates(arrFamily(0)),arrTarget)

'defining number of generations and amount of mutation between following generations
Dim dblGen, dblMut
dblGen=Rhino.GetInteger("set number of generations",100,2,1000)
dblMut=Rhino.GetReal("set mutation value",2,0.01,100)

'defining an array to collect data about different family
Dim arrData
ReDim arrData(n)

'defining a value for better step-element of different family
Dim dblVote

'defining counters, array for data recording and an array for scattering direction
Dim i, j, arrVect, arrVect0, arrRec
ReDim arrVect(2), arrVect0(2), arrRec(1)

'defining random data for first generation
For j=1 To n
arrVect=array(rnd-rnd,rnd-rnd,rnd-rnd)
dblVote=0
arrData(j)=array(dblVote,arrVect)
Next

Dim strLine

'starting evolution system
For i=0 To dblGen-1

Call Rhino.EnableRedraw(False)
'starting family growning
For j=1 To n
arrRec=arrData(j)
arrVect0=arrRec(1)
arrVect=array(arrVect0(0)+dblMut*(dblGen-i)/dblGen*(rnd-rnd),arrVect0(1)+dblMut*(dblGen-i)/dblGen*(rnd-rnd),arrVect0(2)+dblMut*(dblGen-i)/dblGen*(rnd-rnd))
arrVect0=Rhino.VectorUnitize(arrVect)
arrVect=Rhino.VectorScale(arrVect0,dblDist/n)
'generation of new element of the family
arrFamily(j)=Rhino.CopyObject(arrFamily(j-1),arrVect)
strLine=Rhino.AddLine(Rhino.PointCoordinates(arrFamily(j-1)),Rhino.PointCoordinates(arrFamily(j)))
Call Rhino.ObjectColor(strLine, RGB(255-255/dblGen*i,0,255/dblGen*i))

If Rhino.Distance(Rhino.PointCoordinates(arrFamily(j)),arrTarget)arrRec(0) Then
arrData(j)=array(dblVote,arrVect)
End If
End If
Next
For j=1 To n
Call Rhino.DeleteObject(arrFamily(j))
Next

Call Rhino.EnableRedraw(True)
Next

End Sub

tens.tesselation

2009-06-12T01:56:00.006+02:00

Here some other surface tesselation experiments, I have already posted the first one but now it is fixed (no more Rhino.command!). Anyway there is not a relevant physics accuracy in both scripts, take them just as tries.

' CASE 10 SURFSTARS

Sub surfstars(strsurf,upar,vpar)

upar = upar*5

vpar = vpar*5

Dim dblheight : dblheight = rhino.getreal("extrusion height?" ,.05)

If isnull (dblheight) Then Exit Sub

Dim attrpoint : attrpoint = rhino.getobject("point attractor",1)

Dim arrpoint : arrpoint = rhino.PointCoordinates(attrpoint)

Call rhino.enableredraw(False)

Dim i, j

Dim uvalone(1), uvaltwo

Dim arrUone, arrVone

Dim arrpttemp, pointtwo

Dim pt1, pt2, pt3, pt4, pt5, pt6, PT7, Pt8, pt5b, pt6b, pt7b, pt8b, ptc1, ptc2, pt1c, pt2c, pt3c, pt4c

ReDim matrix (upar, vpar)

Dim tempt

arruone = array (0,0)

arrVone = array (0,0)

Dim strcell, arrct, arrptsurf, arrnorm, arrnormend,arrnormenddown, arrline, strcell2

Dim pt1b,pt2b,pt3b,pt4b

If rhino.IsSurface(strsurf) Then

arruone = rhino.surfacedomain(strsurf,0)

arrVone = rhino.surfacedomain(strsurf,1)

End If

For i=0 To upar

For j=0 To vpar

uvalone(0)= ((arruone(1)-arruone(0))/upar)*i

uvalone(1) = ((arrVone(1)-arrVone(0))/vpar)*j

arrpttemp = rhino.EvaluateSurface(strsurf,uvalone)

matrix(i,j) = arrpttemp

Dim oct1, oct2, oct3, oct4, arrlinehuge, arrel1, arrel2, arrdom, midplane, midcircle1, midcircle2

Dim rn, crvtemp, dbldist

For i = 1 To upar-1

For J=0 To vpar-1

pt1 = matrix(i,j)

pt2 = matrix(i+1,j)

pt3 = matrix(i,j+1)

pt4 = matrix(i+1,j+1)

pt5 = array( (pt1(0)+pt2(0))/2,(pt1(1)+pt2(1))/2,(pt1(2)+pt2(2))/2)

pt6 = array( (pt2(0)+pt4(0))/2,(pt2(1)+pt4(1))/2,(pt2(2)+pt4(2))/2)

pt7 = array( (pt3(0)+pt4(0))/2,(pt3(1)+pt4(1))/2,(pt3(2)+pt4(2))/2)

pt8 = array( (pt1(0)+pt3(0))/2,(pt1(1)+pt3(1))/2,(pt1(2)+pt3(2))/2)

ptc1 = array( (pt5(0)+pt7(0))/2,(pt5(1)+pt7(1))/2,(pt5(2)+pt7(2))/2)

ptc2 = array( (pt6(0)+pt8(0))/2,(pt6(1)+pt8(1))/2,(pt6(2)+pt8(2))/2)

dbldist = rhino.Distance(ptc1,arrpoint)

dbldist = Rhino.Log10 (dbldist*3)

If dbldist<1 dbldist ="">

pt5b = array( pt5(0)+(ptc1(0)-pt5(0))/(dbldist),pt5(1)+(ptc1(1)-pt5(1))/(dbldist),pt5(2)+(ptc1(2)-pt5(2))/(dbldist))

pt6b = array( pt6(0)+(ptc2(0)-pt6(0))/(dbldist),pt6(1)+(ptc2(1)-pt6(1))/(dbldist),pt6(2)+(ptc2(2)-pt6(2))/(dbldist))

pt7b = array( pt7(0)+(ptc1(0)-pt7(0))/(dbldist),pt7(1)+(ptc1(1)-pt7(1))/(dbldist),pt7(2)+(ptc1(2)-pt7(2))/(dbldist))

pt8b = array( pt8(0)+(ptc2(0)-pt8(0))/(dbldist),pt8(1)+(ptc2(1)-pt8(1))/(dbldist),pt8(2)+(ptc2(2)-pt8(2))/(dbldist))

Call rhino.AddCurve(array(pt1,pt2,pt4,pt3,pt1),1)

strcell = rhino.addcurve(array(pt1,,pt5b, pt2,pt6b, pt4, pt7b,pt3,pt8b,pt1),1)

arrct = array( (pt4(0)+pt1(0))/2,(pt4(1)+pt1(1))/2,(pt4(2)+pt1(2))/2)

arrptsurf = rhino.SurfaceClosestPoint(strsurf,arrct)

arrnorm = rhino.SurfaceNormal(strsurf,arrptsurf)

arrnorm = rhino.VectorScale(arrnorm, dblheight)

arrnormend = rhino.PointAdd(arrct,arrnorm)

arrnormenddown = rhino.Pointsubtract(arrct,arrnorm)

crvtemp = rhino.AddSrfPt(array(pt1,arrnormend,pt5b))

crvtemp = rhino.AddSrfPt(array(pt5b,arrnormend,pt2))

crvtemp = rhino.AddSrfPt(array(pt2,arrnormend,pt6b))

crvtemp = rhino.AddSrfPt(array(pt6b,arrnormend,pt4))

crvtemp = rhino.AddSrfPt(array(pt4,arrnormend,pt7b))

crvtemp = rhino.AddSrfPt(array(pt7b,arrnormend,pt3))

crvtemp = rhino.AddSrfPt(array(pt3,arrnormend,pt8b))

crvtemp = rhino.AddSrfPt(array(pt8b,arrnormend,pt1))

crvtemp = rhino.AddSrfPt(array(pt1,arrnormenddown,pt5b))

crvtemp = rhino.AddSrfPt(array(pt5b,arrnormenddown,pt2))

crvtemp = rhino.AddSrfPt(array(pt2,arrnormenddown,pt6b))

crvtemp = rhino.AddSrfPt(array(pt6b,arrnormenddown,pt4))

crvtemp = rhino.AddSrfPt(array(pt4,arrnormenddown,pt7b))

crvtemp = rhino.AddSrfPt(array(pt7b,arrnormenddown,pt3))

crvtemp = rhino.AddSrfPt(array(pt3,arrnormenddown,pt8b))

crvtemp = rhino.AddSrfPt(array(pt8b,arrnormenddown,pt1))

arrline = rhino.AddLine(pt1,pt2)

arrdom=rhino.CurveDomain(arrline)

midplane=rhino.CurvePerpFrame(arrline,arrdom(0))

midcircle1=rhino.AddCircle(midplane,0.09)

midplane=rhino.CurvePerpFrame(arrline,arrdom(1))

midcircle2=rhino.AddCircle(midplane,0.09)

Call rhino.AddLoftSrf (Array(midcircle1,midcircle2))

arrline = rhino.AddLine(pt3,pt4)

arrdom=rhino.CurveDomain(arrline)

midplane=rhino.CurvePerpFrame(arrline,arrdom(0))

midcircle1=rhino.AddCircle(midplane,0.09)

midplane=rhino.CurvePerpFrame(arrline,arrdom(1))

midcircle2=rhino.AddCircle(midplane,0.09)

Call rhino.AddLoftSrf (Array(midcircle1,midcircle2))

Call rhino.deleteobject(strsurf)

Call rhino.EnableRedraw(True)

End Sub

'----- CASE 11 SURFholetens -----

Sub SURFholetens (strsurf,upar,vpar)

Dim dblheight : dblheight = rhino.getreal("elements height?" ,.6)

Dim attrpoint : attrpoint = rhino.Getobject("attractor",1)

Dim attrpointcoord : attrpointcoord= rhino.pointcoordinates(attrpoint)

If isnull (dblheight) Then Exit Sub

Call rhino.enableredraw(False)

Dim i, j

Dim uvalone(1), uvaltwo

Dim arrUone, arrVone

Dim arrpttemp, pointtwo

Dim pt1, pt2, pt3, pt4, pt5, pt6, pta, ptb, ptc,ptd

ReDim matrix (upar, vpar)

Dim tempt

arruone = array (0,0)

arrVone = array (0,0)

Dim arrct, arrptsurf, arrnorm, arrnormend, arrline

If rhino.IsSurface(strsurf) Then

arruone = rhino.surfacedomain(strsurf,0)

arrVone = rhino.surfacedomain(strsurf,1)

End If

For i=0 To upar

For j=0 To vpar

uvalone(0)= ((arruone(1)-arruone(0))/upar)*i

uvalone(1) = ((arrVone(1)-arrVone(0))/vpar)*j

arrpttemp = rhino.EvaluateSurface(strsurf,uvalone)

matrix(i,j) = arrpttemp

Dim dbldist

Dim strquad1,strcentr,strquad2,strcell, midline,midcircle1,midcircle2, midplane,arrdom,ptmid

Dim midp1,midpoint1

Dim midp2,midpoint2

For i = 1 To upar-2 Step 3

For J=0 To vpar-2 Step 4

pt1 = matrix(i,j)

pt2 = matrix(i+1,j)

pt3 = matrix(i+2,j+1)

pt4 = matrix(i+1,j+2)

pt5 = matrix(i,j+2)

pt6 = matrix(i-1,j+1)

pta = matrix(i-1,j)

ptb = matrix(i+2,j)

ptc = matrix(i+2,j+2)

ptd = matrix(i-1,j+2)

strcell = rhino.AddCurve(array(pt6,pt1,pt2,pt3,pt4,pt5,pt6),2)

strquad1 = rhino.AddCurve(array(pta,ptb,ptc,ptd,pta),1)

Call rhino.objectcolor(strquad1,rgb(255,255,255))'bianco

arrct = array( (pt6(0)+pt3(0))/2,(pt6(1)+pt3(1))/2,(pt6(2)+pt3(2))/2)

arrptsurf = rhino.SurfaceClosestPoint(strsurf,arrct)

dbldist=rhino.Distance(arrct,attrpointcoord)

dbldist = Rhino.Log10 (dbldist*7)

If dbldist < dbldist ="">

strcell = rhino.scaleobject(strcell,arrct,array(0.95/dbldist,0.95/dbldist,0.95/dbldist))

arrnorm = rhino.SurfaceNormal(strsurf,arrptsurf)

arrnorm = rhino.VectorScale(arrnorm, dblheight)

arrnormend = rhino.PointAdd(arrct,arrnorm)

arrline = rhino.AddLine(arrct,arrnormend)

Call rhino.AddLoftSrf(array(strcell,strquad1))

strquad2=rhino.copyObject(strquad1,arrct,arrnormend)

strcentr=rhino.copyobject(strcell,arrct,arrnormend)

Call rhino.addloftsrf(array(strquad2,strcentr))

Call rhino.addloftsrf(array(strquad2,strquad1))

Call rhino.addloftsrf(array(strcentr,strcell))

midp1 = array((ptd(0)+ptc(0))/2,(ptd(1)+ptc(1))/2,(ptd(2)+ptc(2))/2)

midp2 = array((pta(0)+ptb(0))/2,(pta(1)+ptb(1))/2,(pta(2)+ptb(2))/2)

ptmid= array((arrct(0)+arrnormend(0))/2,(arrct(1)+arrnormend(1))/2,(arrct(2)+arrnormend(2))/2)

midpoint1=rhino.addpoint(midp1)

midpoint2=rhino.AddPoint(midp2)

Call rhino.MoveObjects(array(midpoint1,midpoint2),arrct,ptmid)

midp1=rhino.PointCoordinates(midpoint1)

midp2=rhino.PointCoordinates(midpoint2)

midline = rhino.AddLine(midp1,midp2)

arrdom=rhino.CurveDomain(midline)

midplane=rhino.CurvePerpFrame(midline,arrdom(0))

midcircle1=rhino.AddCircle(midplane,dblheight/6)

midplane=rhino.CurvePerpFrame(midline,arrdom(1))

midcircle2=rhino.AddCircle(midplane,dblheight/6)

Call rhino.AddLoftSrf (Array(midcircle1,midcircle2))

Call rhino.DeleteObjects (array(arrline,strquad1,strcentr,strquad2,strcell,midpoint1,midpoint2,midline,midcircle1,midcircle2))

For i = 2.5 To upar-2 Step 3

For J=2 To vpar-2 Step 4

pt1 = matrix(i,j)

pt2 = matrix(i+1,j)

pt3 = matrix(i+2,j+1)

pt4 = matrix(i+1,j+2)

pt5 = matrix(i,j+2)

pt6 = matrix(i-1,j+1)

pta = matrix(i-1,j)

ptb = matrix(i+2,j)

ptc = matrix(i+2,j+2)

ptd = matrix(i-1,j+2)

strcell = rhino.AddCurve(array(pt6,pt1,pt2,pt3,pt4,pt5,pt6),2)

strquad1 = rhino.AddCurve(array(pta,ptb,ptc,ptd,pta),1)

Call rhino.objectcolor(strquad1,rgb(255,255,255))'bianco

arrct = array( (pt6(0)+pt3(0))/2,(pt6(1)+pt3(1))/2,(pt6(2)+pt3(2))/2)

arrptsurf = rhino.SurfaceClosestPoint(strsurf,arrct)

dbldist=rhino.Distance(arrct,attrpointcoord)

dbldist = Rhino.Log10 (dbldist*7)

If dbldist < dbldist ="">

strcell = rhino.scaleobject(strcell,arrct,array(0.95/dbldist,0.95/dbldist,0.95/dbldist))

arrnorm = rhino.SurfaceNormal(strsurf,arrptsurf)

arrnorm = rhino.VectorScale(arrnorm, dblheight)

arrnormend = rhino.PointAdd(arrct,arrnorm)

arrline = rhino.AddLine(arrct,arrnormend)

Call rhino.AddLoftSrf(array(strcell,strquad1))

strquad2=rhino.copyObject(strquad1,arrct,arrnormend)

strcentr=rhino.copyobject(strcell,arrct,arrnormend)

Call rhino.addloftsrf(array(strquad2,strcentr))

Call rhino.addloftsrf(array(strquad2,strquad1))

Call rhino.addloftsrf(array(strcentr,strcell))

midp1 = array((ptd(0)+ptc(0))/2,(ptd(1)+ptc(1))/2,(ptd(2)+ptc(2))/2)

midp2 = array((pta(0)+ptb(0))/2,(pta(1)+ptb(1))/2,(pta(2)+ptb(2))/2)

ptmid= array((arrct(0)+arrnormend(0))/2,(arrct(1)+arrnormend(1))/2,(arrct(2)+arrnormend(2))/2)

midpoint1=rhino.addpoint(midp1)

midpoint2=rhino.AddPoint(midp2)

Call rhino.MoveObjects(array(midpoint1,midpoint2),arrct,ptmid)

midp1=rhino.PointCoordinates(midpoint1)

midp2=rhino.PointCoordinates(midpoint2)

midline = rhino.AddLine(midp1,midp2)

arrdom=rhino.CurveDomain(midline)

midplane=rhino.CurvePerpFrame(midline,arrdom(0))

midcircle1=rhino.AddCircle(midplane,dblheight/6)

midplane=rhino.CurvePerpFrame(midline,arrdom(1))

midcircle2=rhino.AddCircle(midplane,dblheight/6)

Call rhino.AddLoftSrf (Array(midcircle1,midcircle2))

Call rhino.DeleteObjects (array(arrline,strquad1,strcentr,strquad2,strcell,midpoint1,midpoint2,midline,midcircle1,midcircle2))

Call rhino.DeleteObject(strsurf)

Call rhino.EnableRedraw(True)

End Sub

[Wip] Grasshopper definition in rose curvature way

2009-05-31T21:10:00.005+02:00

This definition create a serie of soft curves, from rose curvatures, along a base curve, related with an analisys surface on top of all

I applied it to obtain a relationship between lines of force fields and the surface derivated from my ambiental analisys diagram

(img updated)

tensegrity - surfacex10

2009-05-31T20:17:00.014+02:00

While I am studying tensegrity structure for my thesis (http://en.wikipedia.org/wiki/Tensegrity), and building weird models like the one up here, I have written a simple script you can implement in my last post collection (just adding another "case" to the nine alredy there, so they are ten now!).

The scripts takes a surface and tesselates it with x-elements (I consider these as tensioned elements) and pipe elements (compressed ones). X-elements are scaled in proximity to an attractor point.

It is very simple so here it is

' CASE 10 SURFSTARS

Sub surfstars(strsurf,upar,vpar)

upar = upar*5

vpar = vpar*5

Dim dblheight : dblheight = rhino.getreal("extrusion height?" ,.05)

If isnull (dblheight) Then Exit Sub

Dim attrpoint : attrpoint = rhino.getobject("point attractor",1)

Dim arrpoint : arrpoint = rhino.PointCoordinates(attrpoint)

Call rhino.enableredraw(False)

Dim i, j

Dim uvalone(1), uvaltwo

Dim arrUone, arrVone

Dim arrpttemp, pointtwo

Dim pt1, pt2, pt3, pt4, pt5, pt6, PT7, Pt8, pt5b, pt6b, pt7b, pt8b, ptc1, ptc2

ReDim matrix (upar, vpar)

Dim tempt

arruone = array (0,0)

arrVone = array (0,0)

Dim strcell, arrct, arrptsurf, arrnorm, arrnormend,arrnormenddown, arrline, strcell2

If rhino.IsSurface(strsurf) Then

arruone = rhino.surfacedomain(strsurf,0)

arrVone = rhino.surfacedomain(strsurf,1)

End If

For i=0 To upar

For j=0 To vpar

uvalone(0)= ((arruone(1)-arruone(0))/upar)*i

uvalone(1) = ((arrVone(1)-arrVone(0))/vpar)*j

arrpttemp = rhino.EvaluateSurface(strsurf,uvalone)

matrix(i,j) = arrpttemp

Dim oct1, oct2, oct3, oct4, arrlinehuge, arrel1, arrel2

Dim rn, crvtemp, dbldist

For i = 1 To upar-1

For J=0 To vpar-1

pt1 = matrix(i,j)

pt2 = matrix(i+1,j)

pt3 = matrix(i,j+1)

pt4 = matrix(i+1,j+1)

pt5 = array( (pt1(0)+pt2(0))/2,(pt1(1)+pt2(1))/2,(pt1(2)+pt2(2))/2)

pt6 = array( (pt2(0)+pt4(0))/2,(pt2(1)+pt4(1))/2,(pt2(2)+pt4(2))/2)

pt7 = array( (pt3(0)+pt4(0))/2,(pt3(1)+pt4(1))/2,(pt3(2)+pt4(2))/2)

pt8 = array( (pt1(0)+pt3(0))/2,(pt1(1)+pt3(1))/2,(pt1(2)+pt3(2))/2)

ptc1 = array( (pt5(0)+pt7(0))/2,(pt5(1)+pt7(1))/2,(pt5(2)+pt7(2))/2)

ptc2 = array( (pt6(0)+pt8(0))/2,(pt6(1)+pt8(1))/2,(pt6(2)+pt8(2))/2)

dbldist = rhino.Distance(ptc1,arrpoint)

dbldist = Rhino.Log10 (dbldist*7)

If dbldist<1.1 dbldist="">

pt5b = array( pt5(0)+(ptc1(0)-pt5(0))/(dbldist),pt5(1)+(ptc1(1)-pt5(1))/(dbldist),pt5(2)+(ptc1(2)-pt5(2))/(dbldist))

pt6b = array( pt6(0)+(ptc2(0)-pt6(0))/(dbldist),pt6(1)+(ptc2(1)-pt6(1))/(dbldist),pt6(2)+(ptc2(2)-pt6(2))/(dbldist))

pt7b = array( pt7(0)+(ptc1(0)-pt7(0))/(dbldist),pt7(1)+(ptc1(1)-pt7(1))/(dbldist),pt7(2)+(ptc1(2)-pt7(2))/(dbldist))

pt8b = array( pt8(0)+(ptc2(0)-pt8(0))/(dbldist),pt8(1)+(ptc2(1)-pt8(1))/(dbldist),pt8(2)+(ptc2(2)-pt8(2))/(dbldist))

Call rhino.AddCurve(array(pt1,pt2,pt4,pt3,pt1),1)

strcell = rhino.addcurve(array(pt1,,pt5b, pt2,pt6b, pt4, pt7b,pt3,pt8b,pt1),1)

arrct = array( (pt4(0)+pt1(0))/2,(pt4(1)+pt1(1))/2,(pt4(2)+pt1(2))/2)

arrptsurf = rhino.SurfaceClosestPoint(strsurf,arrct)

arrnorm = rhino.SurfaceNormal(strsurf,arrptsurf)

arrnorm = rhino.VectorScale(arrnorm, dblheight)

arrnormend = rhino.PointAdd(arrct,arrnorm)

arrnormenddown = rhino.Pointsubtract(arrct,arrnorm)

crvtemp = rhino.AddSrfPt(array(pt1,arrnormend,pt5b))

crvtemp = rhino.AddSrfPt(array(pt5b,arrnormend,pt2))

crvtemp = rhino.AddSrfPt(array(pt2,arrnormend,pt6b))

crvtemp = rhino.AddSrfPt(array(pt6b,arrnormend,pt4))

crvtemp = rhino.AddSrfPt(array(pt4,arrnormend,pt7b))

crvtemp = rhino.AddSrfPt(array(pt7b,arrnormend,pt3))

crvtemp = rhino.AddSrfPt(array(pt3,arrnormend,pt8b))

crvtemp = rhino.AddSrfPt(array(pt8b,arrnormend,pt1))

crvtemp = rhino.AddSrfPt(array(pt1,arrnormenddown,pt5b))

crvtemp = rhino.AddSrfPt(array(pt5b,arrnormenddown,pt2))

crvtemp = rhino.AddSrfPt(array(pt2,arrnormenddown,pt6b))

crvtemp = rhino.AddSrfPt(array(pt6b,arrnormenddown,pt4))

crvtemp = rhino.AddSrfPt(array(pt4,arrnormenddown,pt7b))

crvtemp = rhino.AddSrfPt(array(pt7b,arrnormenddown,pt3))

crvtemp = rhino.AddSrfPt(array(pt3,arrnormenddown,pt8b))

crvtemp = rhino.AddSrfPt(array(pt8b,arrnormenddown,pt1))

arrline = rhino.AddLine(pt1,pt2)

Call rhino.selectobject (arrline)

rhino.Command "_pipe " & ".02 " & ".02 " & " _enter " & " _enter "

rhino.UnselectAllObjects

arrline = rhino.AddLine(pt3,pt4)

Call rhino.selectobject (arrline)

rhino.Command "_pipe " & ".02 " & ".02 " & " _enter " & " _enter "

rhino.UnselectAllObjects

Call rhino.deleteobject(strsurf)

Call rhino.EnableRedraw(True)

End Sub

honeycumb

2009-05-25T15:42:00.009+02:00

Hi guys! Before studying Vink's exeples about texturing I tryed to create an honeycumb surface. It is only a simple test and probably I didn't follow the better way for create an Hexagon grid. In future I'll optimize this, may be using rules like attractors or surface curvature...

(sorry for comments, but is only a draft, and coding is simple to understand)

[EDIT]

well, I modified the code revising some errors (like problems with closed surfaces, not completly solved). I also insert comments. I hope it's clear now... ;-)

[/EDIT]

[EDIT]

I also added a diagram for better explain meaning of formulas with sin() and cos() ;-)

[/EDIT]

Option Explicit
' Script written by Alessandro Zomparelli
' alessandro.zomparelli@gmail.com
' http://alessandrozompa.altervista.org/
' Script version sabato 9 maggio 2009 17.11.41

Call Main()
Sub Main()
Call Rhino.EnableRedraw(False)

Dim strSrf, u, v, arrParC, arrUdom, arrVdom, s, u1, v1
ReDim arrParC(1)
strSrf = Rhino.GetObject("pick target surface")
u1 = Rhino.GetInteger("number of U subdivision", 10, 2)
v1 = Rhino.GetInteger("number of V subdivision", 10, 2)

'we are trying to define a grid for drawing hexagons,
'For Do this we need to define the unit parameter to whom refer coordinates:
'For example I choose the radius of circle in whom hexagon is inscribed
'Now we evaluate the number of radius needed for drawing the choosen number of hexagons
v = v1*2*sin(ToRadians(60))
u = u1*(1+cos(ToRadians(60)))

'Here we ask to user the scale of holes
s = Rhino.GetReal("scale value for holes", 0.5, 0.1, 1)

arrUdom = Rhino.SurfaceDomain(strSrf, 0)
arrVdom = Rhino.SurfaceDomain(strSrf, 1)

Dim arrPts, i, j, arrPtsE, arrPtM
ReDim arrPts(3), arrPtsE(6), arrPtM(2)

'now I define the parameter to use for conversion from xy units to uv
Dim parU, parV
parU=(arrUdom(1)-arrUdom(0))/u
parV=(arrVdom(1)-arrVdom(0))/v

For i=0 To u1/2-1
For j=0 To v1-1

'center of hexagon A
arrParC(0) = 2*i*parU*(1+cos(ToRadians(60)))
arrParC(1) = j*parV*2*sin(ToRadians(60))

'drawing hexagon
Call Hexagon(strSrf, parU, parV, arrParC, arrPtsE)
'creating panels
Call Panel (strSrf, arrParC, arrPtsE, s)

'center of hexagon B
arrParC(0) = 2*(i+0.5)*parU*(1+cos(ToRadians(60)))
arrParC(1) = (j+0.5)*parV*2*sin(ToRadians(60))
'drawing hexagon
Call Hexagon(strSrf, parU, parV, arrParC, arrPtsE)
'creating panels
Call Panel (strSrf, arrParC, arrPtsE, s)
Next
Next
Call Rhino.DeleteObject(strSrf)
Call Rhino.EnableRedraw(True)

End Sub

Sub Hexagon (strSrf, parU, parV, arrParC, arrPtsE)
Dim i, strExa
ReDim arrPtsE(6)
For i=0 To 6
'coordinates of vertex related to local center
arrPtsE(i)=Rhino.EvaluateSurface(strSrf, array(arrParC(0)+cos(i*ToRadians(60))*parU,arrParC(1)+sin(i*ToRadians(60))*parV))
Next
End Sub

Sub Panel (strSrf, arrParC, arrPtsE, s)
Dim strExa, strIn, arrPtM, arrPlane
strExa=Rhino.AddPolyline(arrPtsE)
strIn=Rhino.AddPolyline(arrPtsE)
arrPlane=Rhino.SurfaceNormal(strSrf,arrParC)
If isnull (arrPlane) Then Exit Sub
arrPtM=Rhino.EvaluateSurface(strSrf,arrParC)
Call Rhino.ScaleObject(strIn, arrPtM, (array(s,s,s)))
Call Rhino.MoveObject(strIn,arrPlane)
Call Rhino.AddLoftSrf(array(strExa,strIn))
Call Rhino.DeleteObjects(array(strExa,strIn))
End Sub

The Grasshopper website!

2009-05-14T15:55:00.005+02:00

Bob McNeel announced on the Grasshopper Google Group that the Official Grasshopper site has finally open! Downloads, tutorials, gallery, tips & tricks, videos... all in one place.

http://www.grasshopper3d.com/

Enjoy!

CHAPTER 1 - Textures

2009-05-12T16:32:00.009+02:00

Once upon a time and a very good time it was there was a moocow coming down along the road and this moocow that was coming down along the road met a nicens little boy named baby tuckoo..

..by the way, after applying a lot on scripting I finally start making some render and put some
pieces together.
For this part I took inspiration from the book "Design and visual communication" written by Bruno Munari and his studies about textures (organic or geometric, how to treat a surface to make variations on it but preserving its uniformity, rarefaction and thickening).
First of all I made two grids one with squares and one with triangles and three kind of modules (squares, circles, triangles) and their submodules (in geometric progression). Then I started trying "without thinking".
I also watched at some natural configurations and tried with them.

Then I selected some configurations and I tried to put them on a script.
For this part David Rutten and Theverymany examples were vital.

I thought that best way to deal with textures, their rarefaction and thickening , was to make an application were you can build surfaces (based on based on z = f(x,y[,d,a]) equation) and decide dimension and number of subdivisions (but you can also select an existing surface).

[the only problem is that in this manner I have linked dimension and subdivision, if you want to split them you have firstly to generate the surface and then rerun the script only to tasselate it. But I'll fix it soon, so don't worry]

After that I grouped 9 kind of tesselation I have developed, more or less complex, you
just simple have to set the different parameter and see what you get. It is likely to view how texture changes when you increase o decrease one or both u-v params. And I found that sometimes textures have a good-looking backside lol..
Post it if something nice comes out!

Next step is to see how textures interact with both the surface they are subdividing and the environmental conditions (I tried something about differentiation, attractors, L-system, cellula automata), and also how do they organize in three-dimensional forms and structures... And also something architectural finally... See you soon then!

[p.s.Vray for rhino sucks!]

Option Explicit
' . Script written by Vincenzo Reale
' . univin@libero.it
'Script version sabato 11 maggio 2009 05.02.28

Call SurfacesEditor()

Sub SurfacesEditor()

Dim arrparam, arrresults, arrvalues
Dim strsurf
Dim arrchoose
arrchoose = (array("1° SURFHONEY","2° SURFHEXAGON", "3° SURFGRID","4° SURFRND","5° SURFBOX","6° SURFWAVES","7° SURFBOXHOLE","8° SURFPYRAMID","9° SURFCURVES"))
If isnull (arrchoose) Then Exit Sub

arrparam = array("create surfaces from equation? (Y/N)","equation surfaces z = f(x,y[,D,A])", "u subdivisions (>1)","v subdivisions (>1)")
arrvalues = array("Y","cos(sqr(x^2 + y^2))","5","5")
arrchoose = Rhino.ListBox (arrchoose, "choose!", "SURFACE")
arrresults = rhino.propertylistbox(arrparam, arrvalues,"Parameters","Vink's Surface Editor")

Dim upar, vpar
upar = CInt (formatnumber (arrresults(2)))
If isnull(upar) Then Exit Sub
vpar = CInt (formatnumber (arrresults(3)))
If isnull (vpar) Then Exit Sub

If isarray(arrresults) Then
Select Case Ucase (arrresults(0))
Case "Y"
strsurf = createsurface(arrresults(1), upar,vpar)
Case "N"
strsurf = rhino.getobject("Select surface to texturize",8+16+32,True,True)
End Select

Select Case Ucase (arrchoose)
Case "1° SURFHONEY"
Call surfhoney(strsurf,upar,vpar)
Case "2° SURFHEXAGON"
Call surfhexagon (strsurf,upar,vpar)
Case "3° SURFGRID"
Call surfgrid (strsurf,upar,vpar)
Case "4° SURFRND"
Call surfrnd(strsurf,upar,vpar)
Case "5° SURFBOX"
Call surfbox (strsurf,upar,vpar)
Case "6° SURFWAVES"
Call surfwaves (strsurf,upar,vpar)
Case "7° SURFBOXHOLE"
Call surfboxhole(strsurf,upar,vpar)
Case "8° SURFPYRAMID"
Call surfpyramid (strsurf,upar,vpar)
Case "9° SURFCURVES"
Call surfcurves(strsurf,upar,vpar)

End Select
End If

Call rhino.EnableRedraw(True)
End Sub
' -----------------------------------------------------------------------------------------------------------------------------------------
'----- CREATE SURFACE -----

Function createsurface (streq, upar,vpar)
Dim arrCount(1), nCount, x, y, z
Dim intstart, intEnd
intstart = -5
intEnd = -5

arrCount(0) = upar
arrCount(1) = vpar

nCount = 0
Dim arrpoints()

For x = intstart To arrCount(0) + sgn(intstart) * (abs(intstart)+1)
For y = intend To arrCount(0) + sgn(intend) * (abs(intend)+1)
z = solveequation(streq,x,y)
ReDim Preserve arrpoints(ncount)
arrPoints(nCount) = Array(x, y, z )
nCount = nCount + 1
Next
Next

createsurface = Rhino.AddSrfPtGrid (arrCount, arrPoints)
Call rhino.EnableRedraw(True)

End Function

Function solveequation( ByVal strfunction, ByVal x, ByVal y)
Dim z
Dim D, A, Angledata

D = rhino.Hypot(x,y)
angleData= rhino.Angle(array(0,0,0), array(x,y,0))

' 0 The X,Y angle In degrees.
' 1 The elevation.
' 2 The delta In the X direction.
' 3 The delta In the Y direction.
' 4 The delta In the Z direction.

If isnull (angledata) Then
A = 0.0
Else
A = Rhino.ToRadians(Angledata(0)) 'l'angolo in coordinate polari

End If

On Error Resume Next
Execute("z =" & strfunction)

If err.number = 0 Then
solveequation = z
Else
solveequation = 0.0
End If

End Function
-----------------------------------------------------------------------------------------------------------------------------------------
'----- CASE 1 SURFHONEY -----

Sub surfhoney(strsurf,upar,vpar)
upar = upar*10
vpar = vpar*10
Dim dblheight : dblheight = rhino.getreal("extrusion height?" ,.3)
If isnull (dblheight) Then Exit Sub

Call rhino.enableredraw(False)
Dim i, j
Dim uvalone(1), uvaltwo
Dim arrUone, arrVone
Dim arrpttemp, pointtwo
Dim pt1, pt2, pt3, pt4, pt5, pt6
ReDim matrix (upar, vpar)
Dim tempt

arruone = array (0,0)
arrVone = array (0,0)
Dim strcell, arrct, arrptsurf, arrnorm, arrnormend, arrline, strcell2

If rhino.IsSurface(strsurf) Then
arruone = rhino.surfacedomain(strsurf,0)
arrVone = rhino.surfacedomain(strsurf,1)
End If

For i=0 To upar
For j=0 To vpar
uvalone(0)= ((arruone(1)-arruone(0))/upar)*i
uvalone(1) = ((arrVone(1)-arrVone(0))/vpar)*j
arrpttemp = rhino.EvaluateSurface(strsurf,uvalone)
matrix(i,j) = arrpttemp
Next
Next

Dim oct1, oct2, oct3, oct4, arrlinehuge, arrel1, arrel2
Dim rn

For i = 1 To upar-2 Step 4

For J=0 To vpar-2 Step 2
pt1 = matrix(i,j)
pt2 = matrix(i+1,j)
pt3 = matrix(i+2,j+1)
pt4 = matrix(i+1,j+2)
pt5 = matrix(i,j+2)
pt6 = matrix(i-1,j+1)
strcell = rhino.AddCurve(array(pt1,pt2,pt3,pt4,pt5,pt6,pt1),1)
arrct = array( (pt6(0)+pt3(0))/2,(pt6(1)+pt3(1))/2,(pt6(2)+pt3(2))/2)
arrptsurf = rhino.SurfaceClosestPoint(strsurf,arrct)
rn = rnd

strcell2 = rhino.ScaleObject(strcell,arrct,array(0.5,0.5,0.5),True)

arrnorm = rhino.SurfaceNormal(strsurf,arrptsurf)
arrnorm = rhino.VectorScale(arrnorm, dblheight)
arrnormend = rhino.PointAdd(arrct,arrnorm)
arrline = rhino.AddLine(arrct,arrnormend)

Call rhino.SelectObject (strcell)
rhino.Command("-patch " & "enter")
oct1=rhino.FirstObject
rhino.UnselectAllObjects

rhino.SelectObject (strcell2)
rhino.Command("-patch " & "enter")
oct2=rhino.FirstObject
rhino.UnselectAllObjects

oct3 = rhino.ExtrudeSurface(oct1,arrline)
arrlinehuge = rhino.ExtendCurveLength(arrline,0,1,40)
oct4 = rhino.ExtrudeSurface(oct2,arrlinehuge)

rhino.MoveObject oct4, arrnormend,arrct
arrel1 = (array(oct3))
arrel2 = (array(oct4))

rhino.BooleanDifference arrel1,arrel2

Call rhino.DeleteObject (arrline)
Call rhino.DeleteObject (oct1)
Call rhino.DeleteObject (oct2)

Next
Next

For i = 3 To upar-2 Step 4
For J=1 To vpar-2 Step 2
pt1 = matrix(i,j)
pt2 = matrix(i+1,j)
pt3 = matrix(i+2,j+1)
pt4 = matrix(i+1,j+2)
pt5 = matrix(i,j+2)
pt6 = matrix(i-1,j+1)
strcell = rhino.AddCurve(array(pt1,pt2,pt3,pt4,pt5,pt6,pt1),1)
arrct = array( (pt6(0)+pt3(0))/2,(pt6(1)+pt3(1))/2,(pt6(2)+pt3(2))/2)
arrptsurf = rhino.SurfaceClosestPoint(strsurf,arrct)
rn = rnd

strcell2 = rhino.ScaleObject(strcell,arrct,array(0.5,0.5,0.5),True)

arrnorm = rhino.SurfaceNormal(strsurf,arrptsurf)
arrnorm = rhino.VectorScale(arrnorm, dblheight)
arrnormend = rhino.PointAdd(arrct,arrnorm)
arrline = rhino.AddLine(arrct,arrnormend)

Call rhino.SelectObject (strcell)
rhino.Command("-patch " & "enter")
oct1=rhino.FirstObject
rhino.UnselectAllObjects

rhino.SelectObject (strcell2)
rhino.Command("-patch " & "enter")
oct2=rhino.FirstObject
rhino.UnselectAllObjects

oct3 = rhino.ExtrudeSurface(oct1,arrline)
arrlinehuge = rhino.ExtendCurveLength(arrline,0,1,40)
oct4 = rhino.ExtrudeSurface(oct2,arrlinehuge)

rhino.MoveObject oct4, arrnormend,arrct
arrel1 = (array(oct3))
arrel2 = (array(oct4))

rhino.BooleanDifference arrel1,arrel2

Call rhino.DeleteObject (arrline)
Call rhino.DeleteObject (oct1)
Call rhino.DeleteObject (oct2)
Next
Next

Call rhino.deleteobject(strsurf)
Call rhino.EnableRedraw(True)
End Sub
' -----------------------------------------------------------------------------------------------------------------------------------------
'----- CASE 2 SURFHEXAGON -----

Sub SURFHEXAGON(strsurf,Intuint,Intvint)

Dim dblheight : dblheight = rhino.getreal("extrusion height",.3)
Intuint = IntUint*20
Intvint = Intvint*20
Call rhino.EnableRedraw (False)

Dim arrUdom, arrVdom
arrUdom = Rhino.SurfaceDomain(strsurf,0)
arrVdom = Rhino.SurfaceDomain(strsurf,1)

Dim i, j
Dim arrPt, upar, vpar
ReDim arrPt(intUint-1 , intVint-1)
For i = 0 To Intuint-1
For j = 0 To intvint-1

upar = arrudom(0) + i*(arrudom(1)-arrudom(0))/(intuint-1)
vpar = arrudom(0) + j*(arrvdom(1)-arrvdom(0))/(intvint-1)
arrpt (i,j) = rhino.EvaluateSurface(strsurf,array(upar,vpar))

Next
Next

Dim arrpanel, arrpanel2
Dim strcurvepanel, strcurvepanel2
Dim arrsurfpanel,arrsurfpanel2
Dim strcut, arrCP, dbldist1, dblscale
For i = 6 To Intuint-6 Step 6

For j = 0 To intvint-6 Step 18

arrpanel = array (arrpt(i,j),arrpt(i+3,j+6), arrpt(i-3,j+6),arrpt(i,j))
arrsurfpanel = rhino.addsrfpt(arrpanel)

Next
Next

For i = 0 To Intuint-6 Step 6

For j = 0 To intvint-6 Step 18

arrpanel = array (arrpt(i,j),arrpt(i+6,j), arrpt(i+3,j+6),arrpt(i,j))
arrsurfpanel = rhino.addsrfpt(arrpanel)

Next
Next

For i = 3 To Intuint-6 Step 12

For j = 6 To intvint-6 Step 18

arrpanel = array (arrpt(i,j),arrpt(i+6,j), arrpt(i+3,j+6),arrpt(i,j))
arrsurfpanel = rhino.addsrfpt(arrpanel)

Next
Next
For i = 12 To Intuint-12 Step 12

For j = 0 To intvint-12 Step 18

arrpanel2 = array (arrpt(i,j),arrpt(i-3,j+6), arrpt(i+3,j+6),arrpt(i,j))
strcurvepanel2 = rhino.addcurve(arrpanel2,1)
arrsurfpanel2 = rhino.addsrfpt(arrpanel2)

Next
Next

For i = 6 To Intuint-12 Step 12

For j = 12 To intvint-12 Step 18
arrpanel2 = array (arrpt(i,j),arrpt(i-3,j+6), arrpt(i+3,j+6),arrpt(i,j))
strcurvepanel2 = rhino.addcurve(arrpanel2,1)
arrsurfpanel2 = rhino.addsrfpt(arrpanel2)

Next
Next

Dim arrstrcurvepanel(), k
k =0
For i = 9 To Intuint-9 Step 12
For j = 6 To intvint-12 Step 18
ReDim Preserve arrstrcurvepanel (k)
arrpanel = array (arrpt(i,j),arrpt(i+6,j), arrpt(i+9,j+6),arrpt(i+6,j+12), arrpt(i,j+12),arrpt(i,j+12),arrpt(i-3,j+6),arrpt(i,j))
arrstrcurvepanel(k) = rhino.addcurve(arrpanel,1)
Dim arrct
arrct = array( (arrpt(i-3,j+6)(0)+arrpt(i+9,j+6)(0))/2,(arrpt(i-3,j+6)(1)+arrpt(i+9,j+6)(1))/2,(arrpt(i-3,j+6)(2)+arrpt(i+9,j+6)(2))/2)
Dim arrptsurf
arrptsurf = rhino.SurfaceClosestPoint(strsurf,arrct)
Dim strcell2
strcell2 = rhino.ScaleObject(arrstrcurvepanel(k),arrct,array(0.3,0.3,0.3),True)
Dim arrnorm, arrnormend, arrline
arrnorm = rhino.SurfaceNormal(strsurf,arrptsurf)
arrnorm = rhino.VectorScale(arrnorm, dblheight)
arrnormend = rhino.PointAdd(arrct,arrnorm)
arrline = rhino.AddLine(arrct,arrnormend)

rhino.MoveObject strcell2, arrct, arrnormend
Call rhino.AddLoftSrf(array(arrstrcurvepanel(k),strcell2),,,,,,False)
Call rhino.deleteobject (arrline)
k = k+1
Next
Next

Call rhino.deleteobject(strsurf)
Call rhino.enableredraw(True)
End Sub
' -----------------------------------------------------------------------------------------------------------------------------------------
'----- CASE 3 SURFGRID -----

Sub surfgrid (strsurf,upar,vpar)

Dim radius : radius = rhino.getstring("pipe radius?" ,".1")
If isnull (radius) Then Exit Sub

Call rhino.enableredraw(False)
Dim i, j
Dim uvalone(1), uvaltwo
Dim arrUone, arrVone
Dim arrpttemp, pointtwo
Dim pt1, pt2, pt3, pt4
ReDim matrix (upar, vpar)
Dim tempt

arruone = array (0,0)
arrVone = array (0,0)

If rhino.IsSurface(strsurf) Then
arruone = rhino.surfacedomain(strsurf,0)
arrVone = rhino.surfacedomain(strsurf,1)
End If

For i=0 To upar
For j=0 To vpar
uvalone(0)= ((arruone(1)-arruone(0))/upar)*i
uvalone(1) = ((arrVone(1)-arrVone(0))/vpar)*j
arrpttemp = rhino.EvaluateSurface(strsurf,uvalone)
matrix(i,j) = arrpttemp
Next
Next

For i = 0 To upar-1

For J=0 To vpar-1
pt1 = matrix(i,j)
pt2 = matrix(i+1,j)
pt3 = matrix(i+1,j+1)
pt4 = matrix(i,j+1)

Call grid(pt1,pt2,pt3,pt4, radius)
Next
Next

Call rhino.deleteobject(strsurf)
Call rhino.EnableRedraw(True)
End Sub

Function grid(pt1,pt2,pt3,pt4,radius)

Dim lin12, lin23, lin34, lin41, lin13, lin24

lin12 = rhino.AddLine(pt1,pt2)
lin23 = rhino.AddLine(pt2, pt3)
lin34 = rhino.AddLine(pt3,pt4)
lin41 = rhino.AddLine(pt4, pt1)
lin13 = rhino.AddLine(pt1,pt3)
lin24 = rhino.AddLine(pt2, pt4)

Call rhino.selectobject (lin12)
rhino.Command "_pipe " & radius &" "& radius & " " & " _enter "
rhino.UnselectAllObjects

Call rhino.selectobject (lin23)
rhino.Command "_pipe " & ".1 " & ".1 " & " _enter " & " _enter "
rhino.UnselectAllObjects

Call rhino.selectobject (lin34)
rhino.Command "_pipe " & ".1 " & ".1 " & " _enter " & " _enter "
rhino.UnselectAllObjects

Call rhino.selectobject (lin41)
rhino.Command "_pipe " & ".1 " & ".1 " & " _enter " & " _enter "
rhino.UnselectAllObjects

Call rhino.selectobject (lin13)
rhino.Command "_pipe " & ".1 " & ".1 " & " _enter " & " _enter "
rhino.UnselectAllObjects

Call rhino.selectobject (lin24)
rhino.Command "_pipe " & ".1 " & ".1 " & " _enter " & " _enter "
rhino.UnselectAllObjects

End Function

' -----------------------------------------------------------------------------------------------------------------------------------------
'----- CASE 4 SURFRND -----

Sub surfrnd (strsurf,upar,vpar)

Dim dblheight : dblheight = rhino.getreal("elements height?" ,.3)

If isnull (dblheight) Then Exit Sub

Call rhino.enableredraw(False)
Dim i, j
Dim uvalone(1), uvaltwo
Dim arrUone, arrVone
Dim arrpttemp, pointtwo
Dim pt1, pt2, pt3, pt4, pt5, pt6
ReDim matrix (upar, vpar)
Dim tempt

arruone = array (0,0)
arrVone = array (0,0)
Dim strcell, arrct, arrptsurf, arrnorm, arrnormend, arrline, strcell2

If rhino.IsSurface(strsurf) Then
arruone = rhino.surfacedomain(strsurf,0)
arrVone = rhino.surfacedomain(strsurf,1)
End If

For i=0 To upar
For j=0 To vpar
uvalone(0)= ((arruone(1)-arruone(0))/upar)*i
uvalone(1) = ((arrVone(1)-arrVone(0))/vpar)*j
arrpttemp = rhino.EvaluateSurface(strsurf,uvalone)
matrix(i,j) = arrpttemp
Next
Next

Dim strcell3, strcell4

Dim rn

For i = 1 To upar-2 Step 4

For J=0 To vpar-2 Step 2
pt1 = matrix(i,j)
pt2 = matrix(i+1,j)
pt3 = matrix(i+2,j+1)
pt4 = matrix(i+1,j+2)
pt5 = matrix(i,j+2)
pt6 = matrix(i-1,j+1)

strcell = rhino.AddCurve(array(pt1,pt2,pt3,pt4,pt5,pt6,pt1),2)
arrct = array( (pt6(0)+pt3(0))/2,(pt6(1)+pt3(1))/2,(pt6(2)+pt3(2))/2)
arrptsurf = rhino.SurfaceClosestPoint(strsurf,arrct)
rn = rnd

strcell2 = rhino.ScaleObject(strcell,arrct,array(rn*0.7,rn*0.7,rn*0.7),True)

arrnorm = rhino.SurfaceNormal(strsurf,arrptsurf)
arrnorm = rhino.VectorScale(arrnorm, dblheight)
arrnormend = rhino.PointAdd(arrct,arrnorm)
arrline = rhino.AddLine(arrct,arrnormend)

rn = rnd
strcell3 = rhino.ScaleObject(strcell,arrct,array(rn*0.5,rn*0.5,rn*0.5),True)
strcell4 = rhino.ScaleObject(strcell,arrct,array(0.8,0.8,0.8),True)

rhino.MoveObject strcell3, arrct, arrnormend
rhino.MoveObject strcell4, arrct, arrnormend

Call rhino.AddLoftSrf(array(strcell,strcell2,strcell3,strcell4),,,,,,True)

Call rhino.DeleteObject (arrline)
Call rhino.DeleteObjects (array(strcell,strcell2,strcell3,strcell4))

Next
Next

For i = 3 To upar-2 Step 4
For J=1 To vpar-2 Step 2
pt1 = matrix(i,j)
pt2 = matrix(i+1,j)
pt3 = matrix(i+2,j+1)
pt4 = matrix(i+1,j+2)
pt5 = matrix(i,j+2)
pt6 = matrix(i-1,j+1)

strcell = rhino.AddCurve(array(pt1,pt2,pt3,pt4,pt5,pt6,pt1),2)
arrct = array( (pt6(0)+pt3(0))/2,(pt6(1)+pt3(1))/2,(pt6(2)+pt3(2))/2)
arrptsurf = rhino.SurfaceClosestPoint(strsurf,arrct)
rn = rnd

strcell2 = rhino.ScaleObject(strcell,arrct,array(rn*0.8,rn*0.8,rn*0.8),True)

arrnorm = rhino.SurfaceNormal(strsurf,arrptsurf)
arrnorm = rhino.VectorScale(arrnorm, dblheight)
arrnormend = rhino.PointAdd(arrct,arrnorm)
arrline = rhino.AddLine(arrct,arrnormend)
rn=rnd

strcell3 = rhino.ScaleObject(strcell,arrct,array(rn*0.8,rn*0.8,rn*0.8),True)
strcell4 = rhino.ScaleObject(strcell,arrct,array(0.9,0.9,0.9),True)

rhino.MoveObject strcell3, arrct, arrnormend
rhino.MoveObject strcell4, arrct, arrnormend

Call rhino.AddLoftSrf(array(strcell,strcell2,strcell3,strcell4),,,,,,True)

Call rhino.DeleteObject (arrline)
Call rhino.DeleteObjects (array(strcell,strcell2,strcell3,strcell4))

Next
Next

Call rhino.deleteobject(strsurf)
Call rhino.EnableRedraw(True)
End Sub
' -----------------------------------------------------------------------------------------------------------------------------------------
'----- CASE 5 SURFBOX -----

Sub surfbox(strsurf,upar,vpar)

Call rhino.enableredraw(False)

Dim intposition: intposition = rhino.getreal ("maximum interposition?",0.4,0)
Dim intheight: intheight = rhino.getreal("maximum height?",0.6,0)

Dim i,j
Dim uvalone(1),uvaltwo
Dim arrudom, arrvdom
Dim arrpttemp, pointtwo
Dim pt1, pt2, pt3, pt4
Dim arrpts: arrpts = array(pt1,pt2,pt3,pt4)
ReDim arrpts (upar,vpar)
Dim temppt
arrudom = array(0,0)
arrvdom = array (0,0)

arrudom = rhino.SurfaceDomain(strsurf,0)
arrvdom = rhino.surfacedomain (strsurf,1)

For i = 0 To upar
For j= 0 To vpar
uvalone(0) = ((arrudom(1)-arrudom(0))/upar)*i
uvalone(1) = ((arrvdom(1)-arrvdom(0))/vpar) * (j)
arrpttemp = rhino.EvaluateSurface(strsurf, uvalone)
arrpts(i,j) = arrpttemp
Next
Next

For i = 0 To upar-1
For j=0 To vpar -1
pt1 = arrpts(i,j)
pt2 = arrpts(i+1,j)
pt3 = arrpts(i+1,j+1)
pt4 = arrpts (i,j+1)
Call boxes(pt1,pt2,pt3,pt4,intposition,intheight)

Next
Next

Call rhino.DeleteObject (strsurf)

Call rhino.enableredraw(True)

End Sub

Function boxes (pt1,pt2,pt3,pt4,intposition,intheight)
Dim tempsrf, arrdomainU, arrdomainv, arrdirection
Dim arrparam(1), arrnormal, linenormalsmall, linenormalbig, pt5
Dim linep1p4, linep1p4extend, linearray, linep1p2, linep1p4norm,linep1p2extend
Dim vertsurface1,vertsurface2, arrptdomain,arrptparam,pt6

tempsrf = rhino.AddSrfPt(array(pt1,pt2,pt3,pt4))

arrdomainU = rhino.surfacedomain(tempsrf,0)
arrdomainV = rhino.surfacedomain(tempsrf,1)
arrparam(0) = (arrdomainU(1)-arrdomainu(0))/2
arrparam(1) = (arrdomainV(1)-arrdomainV(0))/2
pt5 = rhino.EvaluateSurface(tempsrf, arrparam)

arrnormal = rhino.surfacenormal(tempsrf, arrparam)

Dim vector
vector = rhino.PointAdd(pt5,arrnormal)
linenormalsmall = rhino.AddLine(pt5, Rhino.VectorAdd(pt5,arrnormal))
linenormalbig = rhino.ExtendCurveLength(linenormalsmall, 0,1,intheight*rnd)

arrptdomain = rhino.CurveDomain(linenormalbig)
arrptparam = arrptdomain(1)
pt6 = rhino.EvaluateCurve(linenormalbig,arrptparam)

linep1p4 = rhino.AddLine(pt1,pt4)
linep1p2 = rhino.AddLine(pt1,pt2)
linep1p4norm = rhino.CopyObject(linep1p4,pt5,pt6)
linep1p4extend = rhino.ExtendCurveLength(linep1p4, 0,1,intposition)
linep1p2extend = rhino.ExtendCurveLength(linep1p2, 0,1,intposition)
linearray= (array(linep1p4extend,linep1p4norm))
vertsurface1 =rhino.AddEdgeSrf(linearray)
vertsurface2 = rhino.ExtrudeSurface(vertsurface1,linep1p2extend)

Call rhino.DeleteObject(tempsrf)
Call rhino.DeleteObjects(array(linep1p4norm,linep1p2extend,linep1p4extend,linep1p2,linep1p4))
rhino.UnselectAllObjects

End Function
' -----------------------------------------------------------------------------------------------------------------------------------------
'----- CASE 9 SURFCURVES -----

Sub SURFCURVES(strsurf,upar,vpar)

Dim U,v, i,j,arrparam(1),arrpoint
Dim arrparamnormal, arrnormal, linenorm
Dim interpcurve
Dim strsurfloft, strinterpcurve, strinterpcurveonsurf, intheight, intloftfreq, intlofttype
Dim arrinterpcurve

upar = upar -1
vpar = vpar -1
intheight = rhino.getreal("maximum height?",1)
If isnull(intheight) Then Exit Sub
intloftfreq = rhino.getinteger("loft frequence?",2,2)
If intloftfreq < intlofttype =" rhino.getreal(">4 Then Exit Sub
intlofttype = intlofttype -1

U = rhino.SurfaceDomain(strsurf,0)
v = rhino.surfacedomain (strsurf,1)
If Not isarray(U) Or Not isarray (v) Then Exit Sub

For i = 0 To upar
arrparam(0) = u (0) + (((u(1)-u(0))/upar)*i)

For j = 0 To vpar
arrparam(1) = v (0) + (((v(1)-v(0))/vpar)*j)
arrpoint = rhino.evaluatesurface(strsurf,arrparam)
arrparamnormal = rhino.surfaceclosestpoint(strsurf,arrpoint)
arrnormal = rhino.surfacenormal(strsurf, arrparamnormal)
arrnormal = rhino.VectorScale(arrnormal,intheight)

Dim arrnvect
arrnvect = rhino.pointAdd(arrpoint,arrnormal)
' linenorm = rhino.AddLine(arrpoint,arrnvect)
' Call rhino.ObjectColor(linenorm,rgb(255,0,255))

ReDim Preserve arrnormptssurf(vpar)
arrnormptssurf(j)=arrpoint
ReDim Preserve arrnormptsEnd(vpar)
If i = 0 And i = upar And j=0 And j=vpar Then
arrnormptsEnd(j) = arrpoint
Else
arrnormptsEnd (j) = arrnvect
End If

Dim intcrossnpts: intcrossnpts = 2
Dim intstripefreq: intstripefreq = i+1
ReDim Preserve arrptwave(vpar)
Dim strWAVE
ReDim Preserve arrptwaveud(vpar)
Dim strwaveud

If intstripefreq Mod 2 Then
If intstripefreq <> 1 Then
If j Mod intcrossnpts Then

arrptwave(j) = arrnormptssurf(j)
arrptwaveud(j) = arrnormptssurf(j)
Else

arrptwave(j) = arrnormptssurfPr(j)
arrptwaveud(j) = arrnormptsEnd(j)
End If
If j = vpar Then

strWAVE = Rhino.AddInterpCrvOnSrf (strsurf,arrptwave)
strwaveud = Rhino.AddInterpCurve (arrptwaveud, 3)

arrInterpCurve = array(strWAVEp(i-1), strwaveudpr(i-1), strWAVE)
strsurfLoft = Rhino.AddLoftSrf (arrInterpCurve, , ,intLoftType,1,100, False)
Call Rhino.SurfaceIsocurveDensity (strsurfLoft, -1)
End If
End If
Else
If j Mod intcrossnpts Then
arrptwave(j) = arrnormptssurfPr(j)
arrptwaveud(j) = arrnormptsEnd(j)
Else
arrptwave(j) = arrnormptssurf(j)
arrptwaveud(j) = arrnormptssurf(j)
End If
If j = vpar Then
strWAVE = Rhino.AddInterpCrvOnSrf (strsurf,arrptwave)
strwaveud = Rhino.AddInterpCurve (arrptwaveud, 3)
If i>1 Then
arrInterpCurve = array(strWAVEp(i-1), strwaveudpr(i-1), strWAVE)
strsurfLoft = Rhino.AddLoftSrf (arrInterpCurve, , ,intLoftType,1,100, False)
Rhino.SurfaceIsocurveDensity strsurfLoft, -1

End If
End If

End If
ReDim Preserve strWAVEp(upar)
strWAVEp(i) = strWAVE
ReDim Preserve strwaveudpr(upar)
strwaveudpr(i) = strwaveud
ReDim Preserve arrnormptssurfPr(vpar)
arrnormptssurfPr(j) = arrnormptssurf(j)
ReDim Preserve arrnormptsEndpr(vpar)
arrnormptsEndpr(j) = arrnormptsEnd(j)

Next

Next

Call rhino.deleteobject (strsurf)

End Sub

' -----------------------------------------------------------------------------------------------------------------------------------------
'----- CASE 7 SURFBOXHOLE -----

Sub surfboxhole(strsurf,upar,vpar)
Call rhino.enableredraw(False)
Dim intposition: intposition = rhino.getreal ("maximum interposition?",0.05,0)
Dim intheight: intheight = rhino.getreal("maximum height?",0.4,0)

Dim i,j
Dim uvalone(1),uvaltwo
Dim arrudom, arrvdom
Dim arrpttemp, pointtwo
Dim pt1, pt2, pt3, pt4
Dim arrpts: arrpts = array(pt1,pt2,pt3,pt4)
ReDim arrpts (upar,vpar)
Dim temppt
arrudom = array(0,0)
arrvdom = array (0,0)

arrudom = rhino.SurfaceDomain(strsurf,0)
arrvdom = rhino.surfacedomain (strsurf,1)

For i = 0 To upar
For j= 0 To vpar
uvalone(0) = ((arrudom(1)-arrudom(0))/upar)*i
uvalone(1) = ((arrvdom(1)-arrvdom(0))/vpar) * (j)
arrpttemp = rhino.EvaluateSurface(strsurf, uvalone)
arrpts(i,j) = arrpttemp
Next
Next

For i = 0 To upar-1
For j=0 To vpar -1
pt1 = arrpts(i,j)
pt2 = arrpts(i+1,j)
pt3 = arrpts(i+1,j+1)
pt4 = arrpts (i,j+1)
Call drawbox2(pt1,pt2,pt3,pt4,intposition,intheight)

Next
Next

Call rhino.DeleteObject (strsurf)

Call rhino.enableredraw(True)

End Sub

Function drawbox2(pt1,pt2,pt3,pt4,intposition,intheight)
Dim tempsrf, arrdomainU, arrdomainv, arrdirection
Dim arrparam(1), arrnormal, linenormalsmall, linenormalbig, pt5
Dim linep1p4, linep1p4extend, linearray, linep1p2, linep1p4norm,linep1p2extend
Dim vertsurface1,vertsurface2, arrptdomain,arrptparam,pt6

tempsrf = rhino.AddSrfPt(array(pt1,pt2,pt3,pt4))

arrdomainU = rhino.surfacedomain(tempsrf,0)
arrdomainV = rhino.surfacedomain(tempsrf,1)
arrparam(0) = (arrdomainU(1)-arrdomainu(0))/2
arrparam(1) = (arrdomainV(1)-arrdomainV(0))/2
pt5 = rhino.EvaluateSurface(tempsrf, arrparam)

arrnormal = rhino.surfacenormal(tempsrf, arrparam)

Dim vector
vector = rhino.PointAdd(pt5,arrnormal)
linenormalsmall = rhino.AddLine(pt5, Rhino.VectorAdd(pt5,arrnormal))
linenormalbig = rhino.ExtendCurveLength(linenormalsmall, 0,1,intheight*rnd)

arrptdomain = rhino.CurveDomain(linenormalbig)
arrptparam = arrptdomain(1)
pt6 = rhino.EvaluateCurve(linenormalbig,arrptparam)

linep1p4 = rhino.AddLine(pt1,pt4)
linep1p2 = rhino.AddLine(pt1,pt2)
linep1p4norm = rhino.CopyObject(linep1p4,pt5,pt6)
linep1p4extend = rhino.ExtendCurveLength(linep1p4, 0,1,intposition)
linep1p2extend = rhino.ExtendCurveLength(linep1p2, 0,1,intposition)
linearray= (array(linep1p4extend,linep1p4norm))
vertsurface1 =rhino.AddEdgeSrf(linearray)
vertsurface2 = rhino.ExtrudeSurface(vertsurface1,linep1p2extend)

Dim linenormhuge
linenormhuge = rhino.ExtendCurveLength(linenormalsmall,0,1,40)
Dim ellipse1
ellipse1 = rhino.AddCurve(array(pt1,pt2,pt3,pt4,pt1))

rhino.SelectObject ellipse1
rhino.Command("-patch " & "enter")

Dim ellipse2

ellipse2=rhino.FirstObject

Dim ellipse3

ellipse3 = rhino.ExtrudeSurface(ellipse2,linenormhuge)

rhino.MoveObject ellipse3, pt6,pt5

Dim arrellipse, arrtrapezoid
arrellipse = (array(ellipse3))
arrtrapezoid = (array(vertsurface2))
rhino.BooleanDifference arrtrapezoid,arrellipse

Call rhino.DeleteObject(tempsrf)
Call rhino.DeleteObject(ellipse2)
Call rhino.DeleteObject(linenormhuge)
Call rhino.DeleteObjects(array(linep1p4norm,linep1p2extend,linep1p4extend,linep1p2,linep1p4))
rhino.UnselectAllObjects

End Function
' -----------------------------------------------------------------------------------------------------------------------------------------
'----- CASE 8 SURFPYRAMID -----

Sub Surfpyramid(strsurf,upar,vpar)
Dim intheight: intheight = rhino.getreal("maximum height?",0.4,0)
Call rhino.enableredraw(False)

Dim i, j
Dim uvalone(1), uvaltwo
Dim arrudom, arrvdom
Dim arrpttemp, pointtwo
Dim pt1, pt2, pt3, pt4

Dim arrpts()
ReDim arrpts (upar, vpar)

arrudom = array(0,0)
arrvdom= array(0,0)

If rhino.IsSurface(strsurf) Then
arrudom = rhino.SurfaceDomain(strsurf, 0)
arrvdom = rhino.SurfaceDomain(strsurf, 1)

End If

For i=0 To upar
For j=0 To vpar
uvalone(0) = ((arrudom(1)-arrudom(0))/upar)*i
uvalone(1) = ((arrvdom(1)-arrvdom(0))/vpar)*j

arrpttemp = rhino.EvaluateSurface(strsurf,uvalone)
arrpts(i,j) = arrpttemp
Next
Next

For i =0 To upar-1
For j=0 To vpar-1
pt1 = arrpts (i,j)
pt2 = arrpts (i+1,j)
pt3 = arrpts (i+1,j+1)
pt4 = arrpts (i,j+1) 'rettangoli di base

Call pyramid (pt1,pt2,pt3,pt4,intheight)
Next

Next

Call rhino.EnableRedraw(True)
Call rhino.deleteobject (strsurf)

End Sub

Function pyramid(pt1,pt2,pt3,pt4,intheight)
Dim tempsrf, arrdomainU, arrdomainV, arrdirection
Dim arrparam(1), arrnormal, linenormalsmall, linenormalbig, arrptdomain, arrptparam
Dim pt5, pt6
Dim sideone, sidetwo, sidethree, sidefour
tempsrf = rhino.addsrfpt (array(pt1,pt2,pt3,pt4))

arrdomainU = rhino.SurfaceDomain(tempsrf,0)
arrdomainv= rhino.SurfaceDomain(tempsrf,1)
arrparam(0) = (arrdomainU(1)-arrdomainU(0))/2
arrparam(1) = (arrdomainv(1)-arrdomainV(0))/2
pt5 = rhino.EvaluateSurface(tempsrf, arrparam)

arrnormal = rhino.surfacenormal (tempsrf, arrparam)

Dim vector
vector = rhino.PointAdd(pt5,arrnormal)
linenormalsmall = rhino.AddLine(pt5, Rhino.VectorAdd(pt5,arrnormal))
linenormalbig = rhino.ExtendCurveLength(linenormalsmall, 0,1,intheight)'maybe rnd*height

rhino.selectobject (tempsrf)
rhino.Command "flip"
arrnormal = rhino.SurfaceNormal(tempsrf, arrparam)
vector = rhino.PointAdd(pt5,arrnormal)
linenormalsmall = rhino.AddLine(pt5, Rhino.VectorAdd(pt5,arrnormal))
'rhino.ExtrudeSurface tempsrf, linenormalsmall
arrptdomain = rhino.curvedomain(linenormalbig)
arrptparam = arrptdomain(1)
pt6 = rhino.EvaluateCurve(linenormalbig, arrptparam)

sideone = rhino.AddSrfPt (array(pt1,pt2,pt6))
sideone = rhino.AddSrfPt (array(pt2,pt3,pt6))
sideone = rhino.AddSrfPt (array(pt3,pt4,pt6))
sideone = rhino.AddSrfPt (array(pt4,pt1,pt6))

Call rhino.deleteobject(linenormalsmall)
Call rhino.deleteobject (linenormalbig)

End Function

' -----------------------------------------------------------------------------------------------------------------------------------------
'----- CASE 6 SURFWAVES -----

Sub Surfwaves (strsurf, nrows, ncolumns)
Dim u, v, i,j, arrparam(1), arrpoint
Dim arrparamnormal, arrnormal, normal, deltaheight
Dim vector, arrnormalnew
Dim strinterpcurve, strinterpcurveonsurf
Dim strsurfloft

nrows = nrows -1
ncolumns = ncolumns -1

deltaheight = rhino.GetReal("wave height?",5,1)
Call rhino.enableredraw(False)

U = RHino.SurfaceDomain(strsurf,0)
v = rhino.surfacedomain(strsurf,1)

If Not isarray(u) Or Not isarray(V) Then Exit Sub

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(strsurf, arrparam)

arrparamnormal = rhino.SurfaceNormal(strsurf,arrparam)
arrparamnormal= rhino.vectorscale(arrparamnormal, CDbl(deltaheight))
vector = rhino.PointAdd(arrpoint,arrparamnormal)
normal = rhino.AddLine(arrpoint, vector)

ReDim Preserve arrnormalendcollection(ncolumns)
If j = 0 And j = ncolumns Then
arrnormalendcollection(j)=arrpoint
Else
arrnormalendcollection(j) = vector
End If

ReDim Preserve arrnormaloriginecollection(ncolumns)
arrnormaloriginecollection(j) = arrpoint

Call rhino.deleteobject (normal)

Next

ReDim Preserve arrInterpcurve(nrows)
If i Mod 2 Then
arrinterpcurve(i) = rhino.addinterpcurve(arrnormalendcollection)
Else
arrinterpcurve(i) = rhino.AddInterpCrvOnSrf(strsurf,arrnormaloriginecollection)
End If

Next

strsurfloft = rhino.AddLoftSrf(arrinterpcurve, , ,3,1,100)
rhino.SurfaceIsocurveDensity strsurfloft, -1
rhino.ObjectColor strsurfloft, rgb(255,0,255)

Call rhino.DeleteObjects (arrinterpcurve)
Call rhino.deleteobject (strsurf)
Call rhino.deleteobjects (vector)
Call rhino.EnableRedraw(True)

End Sub

Interpolation function

2009-05-02T11:18:00.003+02:00

In a discussion on the Grasshopper Google Group, David Rutten (btw... whenever you read, hear or pronounce this name please join hands as in prayer and say "Thank you, Zen master!"), as I said, David Rutten (repeat) has posted a useful and easy to implement function for interpolation. Here's the text extracted from the discussion:

there's a good function that always works when interpolating linearly between two tensors (be they numbers, vectors, points... any kind of data that can be blended).

If you have 2 values (A & B) and you want to interpolate between them at f (a blending factor), the function is always:

R = A + f * (B-A)

For example, let's fill in a few numbers and see what happens... Let's assume we want to find the value one quarter along the way between 15 and 19:

R = 15 + 0.25 * (19-15)
R = 16

Or, let's go twice beyond two points {10, 10, 0} and {12, 15, 4}

R = {10, 10, 0} + 2.0 * ({12, 15, 4} - {10, 10, 0})
R = {10, 10, 0} + 2.0 * ({2, 5, 4}) <---- if you subtract two points you get the vector going from A to B R = {10, 10, 0} + {4, 10, 8} R = {14, 20, 8}

This function is handy because it works without division (no division by zero errors), it works well when A is larger than B and it works for every value of f (i.e. you can also use it to extrapolate).

Well, nothing really new to those of you guys who followed the seminar, we talked and applied a lot of interpolations as a basic task of implementing gradients at different levels of discretization, but I think Rutten explains it very straightforward so it might be useful to have it as a reminder. Now go and apply it to any attractor/repellor/blend case you might undergo from now on.

Paneling Tools in Grasshopper

2009-04-29T09:23:00.002+02:00

Rajaa Issa announces the intention to bring Paneling Tools into Grasshopper.

Here's a quick peek.

Easter Egg

2009-04-13T02:01:00.004+02:00

This is just for laughs, nothing serious, ok? Had some fun doing this small Easter Script.

1. Create a sphere in Rhino and stretch its control points to turn it into an egg

2. run the script below

3. Happy Easter!

Here's the script:

Option Explicit

'
'
'
' . Easter Stripe Egg
' . script written by Alessio Erioli
' .
' . v. 12 April 2009 + 22:05:27
' . © Alessio Erioli
' . monkey Rulez, so play by the rulez.
'____________________________________________________________________________________

Call Easteregg()

Sub Easteregg()

' input surface and division intervals

Dim strSurf: strSurf=Rhino.GetObject("select a surface",8)

' vertical subdivision intervals (<=200, otherwise sweep fails)

Dim intVInt: intVInt=Rhino.GetInteger("n. of V intervals?",200,10)

'lights off!

Rhino.EnableRedraw False

' get surface domain (u and v)

Dim arrUdom,arrVdom, zminPt, zmaxPt

arrUdom = Rhino.SurfaceDomain(strSurf,0)

arrVdom = Rhino.SurfaceDomain(strSurf,1)

' get zmin and zmax points

zminPt=Rhino.EvaluateSurface(strSurf,array(arrUdom(0),arrVdom(0)))

zmaxPt=Rhino.EvaluateSurface(strSurf,array(arrUdom(0),arrVdom(1)))

Dim i, inc, angInc, ang, arrPt, arrPt2, vect, strCrv

Dim arrPts: ReDim arrPts(intVint)

' hetght and angle increments

inc = (zmaxPt(2)-zminPt(2))/intVint

angInc = 180/5

ang = 0

For i = 0 To IntVint

' point along vertical

arrPt= array (zminPt(0),zminPt(1),zminPt(2)+(i*inc))

' second point for vector construction

arrPt2 = array (zminPt(0)+1,zminPt(1),zminPt(2)+(i*inc))

' vector construction and rotation

vect= Rhino.VectorCreate(arrPt, arrPt2)

vect=Rhino.VectorRotate(vect,ang+i*angInc,array(0,0,1))

' projects point to surface

arrPts(i)=Rhino.ProjectPointToSurface(arrPt,strSurf, vect)(0)

If Isnull(arrPts(i)) Then

arrPts(i)=arrPt

End If

Next

' create base curve

strCrv = Rhino.AddInterpCurve(arrPts,3)

Dim arrPlane,arrCircles, dblrad

ReDim arrCircles(intVint)

' create circular sections along curve

For i=0 To intVint

arrPlane=Rhino.CurvePerpFrame(strCrv,Rhino.CurveClosestPoint(strCrv,arrPts(i)))

dblrad=sin(i*pi/intVint)+0.001

arrCircles(i)=Rhino.AddCircle(arrPlane,dblrad)

Next

' add a sweep 1 rail surface

Call Rhino.Addsweep1(strCrv, arrCircles)

' hide unnecessary elements

Rhino.HideObject strCrv

Rhino.HideObject strSurf

Rhino.HideObjects arrCircles

' lights on!

Rhino.EnableRedraw True

End Sub

Rhinoscript new release

2009-04-02T18:50:00.003+02:00

A new version of Rhinoscript is available for download, in order to accomplish the changes and fixes of Rhino 4.0 SR 5.

Download it from RhinoLabs page:

http://en.wiki.mcneel.com/default.aspx/McNeel/RhinoScriptLabs.html

Grasshopper manuals - IMPORTANT RELEASES

2009-04-02T15:01:00.007+02:00

1. Andrew Payne from LIFT architects has released a new update of his Grasshopper Primer. Rajaa Issa has given a huge contribution in this issue, and the most important feature is a section dedicated to VB.net scripting in Grasshopper. Download it here:

http://www.liftarchitects.com/journal/2009/3/25/the-grasshopper-primer-second-edition.html

2. Mohamad Khabazi has released an impressive 180 pages guide to algorithmic modeling in Grasshopper based on the studies at EmTech AA made in fall 2008, a must for architectural exploration with this tool. Download it here:

http://blog.rhino3d.com/2009/04/algorithmic-modelling-with-grasshopper.html

Enjoy!!!

phyllotaxis pavilion 02

2009-03-27T16:12:00.003+01:00

this is another evolution in my pavilion project.
i used two Fibonacci's number (13 and 21) different from previous experiment, in this way i could obtain smaller panels that make more evident the modulation of holes.
i modified the tubolar shape, so in the middle of the generator curve the pavilion section is more similar to an ellipse than a circle.
to obtain a more standardized shape of the triangular panel (in previous experiments they are more stretched in pavilion extremes), generator curve is not divided in equal part but division lenght change with the distance from an attractor point (which influences pavilion radius also).
for this pavilion i created a double membrane, it's thicker near the ground (to be more resistant) and became thinner going to the top. the modulation of holes is achieved by an attractor point placed near the middle of the curve generator.

Option Explicit
'Script written by andrea bugli
' "SHIFT" http://andbug.blogspot.com
'Script version venerdì 6 marzo 2009 19.54.31

Call pavilion02triangular
Sub pavilion02triangular

Call rhino.enableredraw(False)

Dim strBpts,arrcircle
Dim strcurve: strcurve = rhino.GetObject("select a curve", 4, True, True)
Dim domain: domain = rhino.CurveDomain(strCurve)
Dim domPt(), distPt, intcount
intcount = 0

Dim ptparam1: ptparam1 = rhino.GetObject("select curve attractor point", 1)
Dim ptcoord1: ptcoord1 = rhino.PointCoordinates(ptparam1)
Dim strAttrHoles: strAttrHoles = rhino.GetObject("select holes attractor point", 1)
Dim arrAttrHoles: arrAttrHoles = rhino.PointCoordinates(strAttrHoles)
Dim strMeshGr: strMeshGr = rhino.GetObject("select ground mesh", 32)
Call rhino.AddLayer("glass")

ReDim Preserve domPt(0)
domPt(intcount) = domain(0)
''''''''' division of generator curve based on distance from ptcoord1
Do
intcount = intcount+1
distPt = rhino.Distance(ptcoord1, rhino.EvaluateCurve(strcurve, domPt(intcount-1)))
If domPt(intcount-1)+(0.035/distPt) > domain(1) Then Exit Do
ReDim Preserve domPt(intcount)
domPt(intcount) = domPt(intcount-1)+(0.018/distPt)
Loop

ReDim arrcircle(ubound(domPt))
Dim i, dblRad
Dim ptrot, pt, ptcurve
ReDim ptrot(ubound(domPt))

rhino.EnableRedraw(False)

For i = 0 To ubound(domPt)
Dim strPoncurve: strPoncurve = rhino.EvaluateCurve(strcurve, dompt(i))
Dim strframe: strframe = rhino.Curveperpframe(strcurve, dompt(i))
Dim tang: tang = rhino.curvetangent(strcurve, dompt(i))
Dim dist: dist = rhino.Distance(strPoncurve, ptcoord1)

arrcircle(i) = rhino.addcircle(strframe, 60/dist)
ptcurve = rhino.CurveStartPoint(arrcircle(i))
pt = rhino.addpoint(ptcurve)
dblRad = rhino.distance(strPoncurve, ptcurve)
''''''''' tubolar shape is scaled to obtain a pavilion section more similar to an ellipse than a circle
ptrot(i) = rhino.RotateObject(pt, strPoncurve, 137.52*i, tang, True)
ptrot(i) = rhino.ScaleObject(ptrot(i), strPoncurve, array((1+dblRad*0.015),(1+dblRad*0.015),(1-dblRad*0.035)))

Call rhino.Deleteobject(pt)
Next

Dim arrVectPos, arrVectNeg, arrPtPos
ReDim arrPtPos(ubound(ptrot))
Dim arrPtOnMesh, dblDistPtM, dblDistCrv
''''''''' here i create the double membrane
For i = 0 To ubound(ptrot)

arrPtOnMesh = rhino.MeshClosestPoint(strMeshGr, rhino.PointCoordinates(ptrot(i)))
dblDistPtM = rhino.Distance(arrPtonMesh(0), rhino.PointCoordinates(ptrot(i)))
dblDistCrv = rhino.Distance(rhino.PointCoordinates(ptrot(i)), rhino.EvaluateCurve(strcurve, dompt(i)))
strPoncurve = rhino.EvaluateCurve(strcurve, dompt(i))
arrVectPos = rhino.VectorCreate(rhino.PointCoordinates(ptrot(i)), strPoncurve)
arrVectPos = rhino.VectorUnitize(arrVectPos)
arrVectPos = rhino.VectorScale(arrVectPos, 0.75*((dblDistCrv-1.4)/(dblDistPtM+3.5)))
arrPtPos(i) = rhino.PointAdd(rhino.PointCoordinates(ptrot(i)), arrVectPos)
''''''''' double membrane is thicker near the ground
If (dblDistPtM < 6) Then
arrVectPos = rhino.VectorScale(arrVectPos, (6 /(dblDistPtM + 3))^2)
End If

arrPtPos(i) = rhino.PointAdd(rhino.PointCoordinates(ptrot(i)), arrVectPos)

Next

Dim strCrv1(), strCrv2()
ReDim arrCrv1(ubound(ptrot))
ReDim arrCrv2(ubound(ptrot))
''''''''' here i start to create triangles on the inner membrane
For i = 0 To ubound(ptrot)-34
arrCrv1(i) = rhino.AddInterpCurve(array(rhino.PointCoordinates(ptrot(i)), rhino.PointCoordinates(ptrot(i+21)), rhino.PointCoordinates(ptrot(i+13)),rhino.PointCoordinates(ptrot(i))),1)
arrCrv2(i) = rhino.AddInterpCurve(array(rhino.PointCoordinates(ptrot(i+13)), rhino.PointCoordinates(ptrot(i+21)), rhino.PointCoordinates(ptrot(i+34)), rhino.PointCoordinates(ptrot(i+13))),1)
Next

Dim strCrvPos1(), strCrvPos2()
ReDim arrCrvPos1(ubound(ptrot))
ReDim arrCrvPos2(ubound(ptrot))
''''''''' here i start to create triangles on the outer membrane
For i = 0 To ubound(arrPtPos)-34
arrCrvPos1(i) = rhino.AddInterpCurve(array(arrPtPos(i), arrPtPos(i+21), arrPtPos(i+13),arrPtPos(i)),1)
arrCrvPos2(i) = rhino.AddInterpCurve(array(arrPtPos(i+13), arrPtPos(i+21), arrPtPos(i+34),arrPtPos(i+13)),1)
Next

For i = 0 To ubound(arrPtPos)-34
Call rhino.AddLoftSrf(array(arrCrv1(i), arrCrvPos1(i)))
Call rhino.AddLoftSrf(array(arrCrv2(i), arrCrvPos2(i)))
Next

Dim arrCenter1(), arrCenter2()
Dim dblDistAttr1, dblDistAttr2
Dim arrVectAC1, arrVectBC1, arrVectCC1, arrPtAC1, arrPtBC1, arrPtCC1
Dim arrVectAC2, arrVectBC2, arrVectCC2, arrPtAC2, arrPtBC2, arrPtCC2
Dim dblScale1, dblScale2, dblDistHole
ReDim arrCenter1(ubound(arrPtPos)-34)
ReDim arrCenter2(ubound(arrPtPos)-34)
Dim strGlass
''''''''' here i create triangular holes, their size is influenced by the distance from arrAttrHoles
For i = 0 To ubound(arrPtPos)-34

arrCenter1(i) = rhino.CurveAreaCentroid(arrCrvPos1(i))

arrVectAC1 = rhino.VectorCreate(arrCenter1(i)(0), rhino.PointCoordinates(ptrot(i)))
arrVectBC1 = rhino.VectorCreate(arrCenter1(i)(0), rhino.PointCoordinates(ptrot(i+13)))
arrVectCC1 = rhino.VectorCreate(arrCenter1(i)(0), rhino.PointCoordinates(ptrot(i+21)))

dblDistHole = rhino.Distance(arrCenter1(i)(0), arrAttrHoles)
dblScale1 = 0.8/(dblDistHole * 0.1)

If (dblScale1 < 0.95) Then

arrVectAC1 = rhino.VectorScale(arrVectAC1, dblScale1)
arrVectBC1 = rhino.VectorScale(arrVectBC1, dblScale1)
arrVectCC1 = rhino.VectorScale(arrVectCC1, dblScale1)
arrPtAC1 = rhino.PointAdd(rhino.PointCoordinates(ptrot(i)), arrVectAC1)
arrPtBC1 = rhino.PointAdd(rhino.PointCoordinates(ptrot(i+13)), arrVectBC1)
arrPtCC1 = rhino.PointAdd(rhino.PointCoordinates(ptrot(i+21)), arrVectCC1)

Call rhino.AddSrfPt(array(rhino.PointCoordinates(ptrot(i)), rhino.PointCoordinates(ptrot(i+13)), arrPtBC1, arrPtAC1))
Call rhino.AddSrfPt(array(rhino.PointCoordinates(ptrot(i+13)), rhino.PointCoordinates(ptrot(i+21)), arrPtCC1, arrPtBC1))
Call rhino.AddSrfPt(array(rhino.PointCoordinates(ptrot(i+21)), rhino.PointCoordinates(ptrot(i)), arrPtAC1, arrPtCC1))
Call rhino.AddSrfPt(array(arrPtPos(i), arrPtAC1, arrPtBC1, arrPtPos(i+13)))
Call rhino.AddSrfPt(array(arrPtPos(i+13), arrPtBC1, arrPtCC1, arrPtPos(i+21)))
Call rhino.AddSrfPt(array(arrPtPos(i+21), arrPtCC1, arrPtAC1, arrPtPos(i)))
''''''''' i put the surface in the glass layer
strGlass = rhino.AddSrfPt(array(arrPtAC1, arrPtCC1, arrPtBC1))
Call rhino.ObjectLayer(strGlass, "glass")

Else

arrPtAC1 = rhino.PointAdd(rhino.PointCoordinates(ptrot(i)), arrVectAC1)
arrPtBC1 = rhino.PointAdd(rhino.PointCoordinates(ptrot(i+13)), arrVectBC1)
arrPtCC1 = rhino.PointAdd(rhino.PointCoordinates(ptrot(i+21)), arrVectCC1)

Call rhino.AddSrfPt(array(rhino.PointCoordinates(ptrot(i)), rhino.PointCoordinates(ptrot(i+13)), arrPtBC1))
Call rhino.AddSrfPt(array(rhino.PointCoordinates(ptrot(i+13)), rhino.PointCoordinates(ptrot(i+21)), arrPtCC1))
Call rhino.AddSrfPt(array(rhino.PointCoordinates(ptrot(i+21)), rhino.PointCoordinates(ptrot(i)), arrPtAC1))
Call rhino.AddSrfPt(array(arrPtPos(i), arrPtAC1, arrPtPos(i+13)))
Call rhino.AddSrfPt(array(arrPtPos(i+13), arrPtBC1, arrPtPos(i+21)))
Call rhino.AddSrfPt(array(arrPtPos(i+21), arrPtCC1, arrPtPos(i)))

End If

'----------------

arrCenter2(i) = rhino.CurveAreaCentroid(arrCrvPos2(i))

arrVectAC2 = rhino.VectorCreate(arrCenter2(i)(0), rhino.PointCoordinates(ptrot(i+13)))
arrVectBC2 = rhino.VectorCreate(arrCenter2(i)(0), rhino.PointCoordinates(ptrot(i+21)))
arrVectCC2 = rhino.VectorCreate(arrCenter2(i)(0), rhino.PointCoordinates(ptrot(i+34)))

dblDistHole = rhino.Distance(arrCenter2(i)(0), arrAttrHoles)
dblScale2 = 0.8/(dblDistHole * 0.1)

If (dblScale2 < 0.95) Then

arrVectAC2 = rhino.VectorScale(arrVectAC2, dblScale2)
arrVectBC2 = rhino.VectorScale(arrVectBC2, dblScale2)
arrVectCC2 = rhino.VectorScale(arrVectCC2, dblScale2)
arrPtAC2 = rhino.PointAdd(rhino.PointCoordinates(ptrot(i+13)), arrVectAC2)
arrPtBC2 = rhino.PointAdd(rhino.PointCoordinates(ptrot(i+21)), arrVectBC2)
arrPtCC2 = rhino.PointAdd(rhino.PointCoordinates(ptrot(i+34)), arrVectCC2)

Call rhino.AddSrfPt(array(rhino.PointCoordinates(ptrot(i+13)), arrPtAC2, arrPtBC2, rhino.PointCoordinates(ptrot(i+21))))
Call rhino.AddSrfPt(array(rhino.PointCoordinates(ptrot(i+21)), arrPtBC2, arrPtCC2, rhino.PointCoordinates(ptrot(i+34))))
Call rhino.AddSrfPt(array(rhino.PointCoordinates(ptrot(i+34)), arrPtCC2, arrPtAC2, rhino.PointCoordinates(ptrot(i+13))))
Call rhino.AddSrfPt(array(arrPtPos(i+13), arrPtPos(i+21), arrPtBC2, arrPtAC2))
Call rhino.AddSrfPt(array(arrPtPos(i+21), arrPtPos(i+34), arrPtCC2, arrPtBC2))
Call rhino.AddSrfPt(array(arrPtPos(i+34), arrPtPos(i+13), arrPtAC2, arrPtCC2))
''''''''' i put the surface in the glass layer
strGlass = rhino.AddSrfPt(array(arrPtAC2, arrPtBC2, arrPtCC2))
Call rhino.ObjectLayer(strGlass, "glass")

Else

arrPtAC2 = rhino.PointAdd(rhino.PointCoordinates(ptrot(i+13)), arrVectAC2)
arrPtBC2 = rhino.PointAdd(rhino.PointCoordinates(ptrot(i+21)), arrVectBC2)
arrPtCC2 = rhino.PointAdd(rhino.PointCoordinates(ptrot(i+34)), arrVectCC2)

Call rhino.AddSrfPt(array(rhino.PointCoordinates(ptrot(i+13)), arrPtAC2, rhino.PointCoordinates(ptrot(i+21))))
Call rhino.AddSrfPt(array(rhino.PointCoordinates(ptrot(i+21)), arrPtBC2, rhino.PointCoordinates(ptrot(i+34))))
Call rhino.AddSrfPt(array(rhino.PointCoordinates(ptrot(i+34)), arrPtCC2, rhino.PointCoordinates(ptrot(i+13))))
Call rhino.AddSrfPt(array(arrPtPos(i+13), arrPtPos(i+21), arrPtBC2))
Call rhino.AddSrfPt(array(arrPtPos(i+21), arrPtPos(i+34), arrPtCC2))
Call rhino.AddSrfPt(array(arrPtPos(i+34), arrPtPos(i+13), arrPtAC2))

End If

Next

Call rhino.DeleteObjects(ptrot)
call rhino.DeleteObjects(arrCircle)
Call rhino.enableredraw(True)

End Sub

ivy_thigmotropism II

2009-03-17T03:48:00.029+01:00

This is just another attempt to improve the script and recreate the phenomenon of thigmotropism. In this case the organism grows in a surface even if there are some parameters that I still not control at all. I'm thinking of what this system can evolve and create forms and spaces even though in nature it's a parasite.

Option Explicit
'Giacomo Damiani
'Script version lunedì 16 marzo 2009 23.50.56

Call Main()
Sub Main()

Dim n,i,j,p, dblparam,dblparam2, dblradius,arrplane,strcurve,arrCirc2, strcurvecrv,arrcrvdata,arrCPlane,arrPlane3,ArrRPlane,Arrmoveplane,dblparam3,arrcurve

Dim strcrv: strcrv = Rhino.GetObject("select curve",4)
Dim strsrf: strsrf = Rhino.GetObject("select surface",8)

If isNull(strcrv) Then Exit Sub
If isNull(strsrf) Then Exit Sub

Dim IntNPt: intNPt = Rhino.GetInteger("how many frame?", 60, 10, 80)
Call Rhino.EnableRedraw(False)

Dim arrDom3: arrDom3 = Rhino.CurveDomain(strCrv)

Dim dblstep3: dblStep3 = (arrDom3(1)-arrDom3(0))/(intNPt+1)
ReDim arrplane3(intNpt-1)
ReDim dblparam3(intNpt-1)

For p=0 To intNpt-1

dblParam3(p) = arrDom3(0) + p*dblStep3
arrPlane3(p) = Rhino.CurvePerpFrame(strcrv, dblParam3(p))
'i take a curve and the section is make in planes create by this curve

arrcurve = Rhino.AddSrfSectionCrvs(strsrf,arrPlane3(p))
'section to the surface

If isNull (arrCurve) Then Exit Sub

Dim IntNPts: intNPts = Rhino.GetInteger("how many samples?", 100, 10, 200) 'chiedo il dimensionamento

If isNull (intNpts) Then Exit Sub

ReDim arrCirc(intNpts-1)
ReDim arrCirc2(intNpts-1)

Dim arrpt,strpt,arrpt2,arrpte,strpt2, strcurve1,arrplane2,dblradius2
ReDim arrcurve1(intNpts-1)
ReDim arrpt2(intNpts-1)
ReDim arrpte(intNpts-1)
ReDim arrpt(intNpts-1)
ReDim arrplane(intNpts-1)

For n=0 To ubound (arrcurve)

Dim arrDom: arrDom = Rhino.CurveDomain(arrCurve(n))
Dim dblstep: dblStep = (arrDom(1)-arrDom(0))/intNPts

For i=0 To intNpts-1

dblParam = arrDom(0) + i*dblStep
arrPlane(i) = Rhino.CurvePerpFrame(arrCurve(n), dblParam)

dblRadius = 0.09

arrCrvData = Rhino.CurveCurvature (arrCurve(n), dblParam)

arrCirc(i) = Rhino.AddCircle(arrPlane(i),dblRadius)

arrpt(i) = Rhino.EvaluateCurve(arrCurve(n),dblParam)

strpt = Rhino.AddPoint(arrpt(i))
arrpte(i) = Rhino.EvaluateCurve(arrcirc(i),dblparam*i)
arrpt2(i) = Rhino.MoveObject(strpt,arrpt(i),arrpte(i))
'arrCrvData = Rhino.CurveCurvature (strCurve, dblParam)

Next

strcurve = Rhino.AddInterpCurve(arrpte)
'strcurve(i)=arrcurve
Dim arrDom2: arrDom2 = Rhino.CurveDomain(strcurve)
Dim dblstep2: dblStep2 = (arrDom2(1)-arrDom2(0))/intNPts

For j=0 To ubound (arrpte)

dblParam2 = arrDom2(0) + j*dblStep2

arrPlane2 = Rhino.CurvePerpFrame(strcurve,dblparam2)
dblradius2 = 3/(j+6)

arrcirc2(j) = Rhino.AddCircle(arrplane2,dblradius2)
Next

'Call Rhino.AddLoftSrf(arrCirc)
Call Rhino.AddLoftSrf(arrCirc2)

Next

'Call Rhino.ObjectColor(arrCirc(i),RGB(0,0,255))

Next

Call Rhino.EnableRedraw(True)
Call Rhino.HideObject(strsrf)

End Sub

Rhizome - part II

2009-03-15T19:36:00.009+01:00

Here's my second attempt to create a rhizomatic system. I changed the previus planes for a surface, a sort of skin that separate interior from exterior -apart from specific holes, depending to attractor points.

Option Explicit
'Script written by
'Script copyrighted by
'Script version domenica 15 marzo 2009 19.40.15
Call Main()
Sub Main()
Dim arrCrv: arrCrv=Rhino.GetObjects("select data curves", 4)
Dim strSrf, strSrf0: strSrf0 = Rhino.AddLoftSrf(ArrCrv)
Dim intUInt: intUInt = Rhino.GetInteger("number of U intervals?", 10, 5)
Dim intVInt: intVInt = Rhino.GetInteger("number of V intervals?", 10, 5)
Dim IntNPts: intNPts = Rhino.GetInteger("how many samples for the curves?", 100, 50, 200)
If isNull (intNpts) Then Exit Sub
strSrf=strSrf0(0)
Dim arrUdom, arrVdom, arrpanel
ArrUdom = Rhino.SurfaceDomain(strSrf, 0)
ArrVdom = Rhino.SurfaceDomain(strSrf, 1)
Call Rhino.Print("surface U domain: from " & arrUdom(0) & " to " & arrUdom(1))
Call Rhino.Print("surface V domain: from " & arrVdom(0) & " to " & arrVdom(1))
Dim i, j, arrPt, Upar, Vpar, strFrame, dblUdist, dblVdist
ReDim arrPt(intUint-1, intVint-1)
Call Rhino.EnableRedraw(False)
For i=0 To IntUInt-1
For j=0 To intVInt-1
Upar= arrUdom(0)+i*(arrUdom(1)-arrUdom(0))/(intUInt-1)
Vpar= arrVdom(0)+j*(arrVdom(1)-arrVdom(0))/(intVInt-1)
'evaluating surface at (upar, vpar), it gives a 3d point
arrPt(i,j)=Rhino.EvaluateSurface(strSrf, array(upar, vpar))
'place a point there; describing a surface with loads of points
Call Rhino.addpoint(arrPt(i, j))
Next
Next
Dim ArrPtCurves(), arrPtCurvesC(), ArrCurves1()
ReDim ArrCurves1(intUInt-1)
Dim p, n
For p=0 To IntUInt-1
n=0
ReDim ArrPtCurves(p,n)
For i=0 To IntUInt-1
For j=0 To intVInt-1
If i= (j+p) Then
ReDim Preserve ArrPtCurves (p,n)
ReDim Preserve ArrPtCurvesC (n)
ArrPtCurves (p,n) = ArrPt(i,j)
ArrPtCurvesC(n)= arrPtCurves(p,n)
n=n+1
End If
Next
Next
ArrCurves1(p) = Rhino.AddCurve(arrPtCurvesC)
If n>2 Then
Dim dblRadius, q, ArrCirc, ArrPts
Dim arrDom: arrDom = Rhino.CurveDomain(arrCurves1(p))
Dim dblparam, arrCrvData, dblStep, arrPlane
ReDim arrCirc(intNpts)
dblStep = (arrDom(1)-arrDom(0))/(intNPts+1)
For q=0 To intNPts
dblParam = arrDom(0) + q*dblStep
arrCrvData = Rhino.CurveCurvature (arrCurves1(p), dblParam)
arrPlane = Rhino.CurvePerpFrame(arrCurves1(p), dblParam)
If Not isNull (arrCrvData) Then
dblRadius= 5/arrCrvData(3)
Else
dblRadius = 1
End If
arrCirc(q) = Rhino.AddCircle(arrPlane, dblRadius)
Next
Call Rhino.AddLoftSrf(arrCirc)
End If
Next
Dim ArrCurves2()
ReDim ArrCurves2(intUInt-1)
For p=0 To IntUInt-1
n=0
ReDim ArrPtCurves(p,n)
For i=1 To IntUInt-1
For j=0 To intVInt-1
If (i+p)=j Then
ReDim Preserve ArrPtCurves(p,n)
ReDim Preserve ArrPtCurvesC (n)
ArrPtCurves (p,n) = ArrPt(i,j)
ArrPtCurvesC(n)= arrPtCurves(p,n)
n=n+1
End If
Next
Next
ArrCurves2(p) = Rhino.AddCurve(arrPtCurvesC)
If n>2 Then
arrDom = Rhino.CurveDomain(arrCurves2(p))
ReDim arrCirc(intNpts)
dblStep = (arrDom(1)-arrDom(0))/(intNPts+1)
For q=0 To intNPts
dblParam = arrDom(0) + q*dblStep
arrCrvData = Rhino.CurveCurvature (arrCurves2(p), dblParam)
arrPlane = Rhino.CurvePerpFrame(arrCurves2(p), dblParam)
If Not isNull (arrCrvData) Then
dblRadius= 5/arrCrvData(3)
Else
dblRadius = 1
End If
arrCirc(q) = Rhino.AddCircle(arrPlane, dblRadius)
Next
Call Rhino.AddLoftSrf(arrCirc)
End If
Next
Dim ArrCurves3()
ReDim ArrCurves3(2*(intUInt-1))
For p=0 To 2*(IntUInt-1)
n=0
ReDim ArrPtCurves(p,n)
For i=0 To IntUInt-1
For j=0 To intVInt-1
If i+j=p Then
ReDim Preserve ArrPtCurves (p,n)
ReDim Preserve ArrPtCurvesC (n)
ArrPtCurves (p,n) = ArrPt(i,j)
ArrPtCurvesC(n)= arrPtCurves(p,n)
n=n+1
End If
Next
Next
ArrCurves3(p) = Rhino.AddCurve(arrPtCurvesC)
If n>2 Then
arrDom = Rhino.CurveDomain(arrCurves3(p))
ReDim arrCirc(intNpts)
dblStep = (arrDom(1)-arrDom(0))/(intNPts+1)
For q=0 To intNPts
dblParam = arrDom(0) + q*dblStep
arrCrvData = Rhino.CurveCurvature (arrCurves3(p), dblParam)
arrPlane = Rhino.CurvePerpFrame(arrCurves3(p), dblParam)
If Not isNull (arrCrvData) Then
dblRadius= 5/arrCrvData(3)
Else
dblRadius = 1
End If
arrCirc(q) = Rhino.AddCircle(arrPlane, dblRadius)
Next
Call Rhino.AddLoftSrf(arrCirc)
End If
Next
'Call Rhino.HideObject(strsrf)
'Call Rhino.MoveObject(StrSrf, array(0,0,0), array(0,0,2))
Dim strCrvTax
'Call Rhino.EnableRedraw(true)
Dim Stratt: strAtt = Rhino.GetObject("select attractor point",1)
Dim arrPtAtt: arrPtAtt = Rhino.PointCoordinates(strAtt)
'imput theresold distance
Dim dblTdist: dblTdist=Rhino.Getreal("threshold distance?",30,10)
'scale objects if inside theresold:
Dim arrBB,arrCP,dbldist,dblscale'center point
Dim k
Dim ArrPlanSrf
ReDim ArrPlanSrf(k)
Dim ArrPanelSrf1, ArrSrfPts1, ArrPanelSrf2, ArrSrfPts2
Dim e: e=0
Dim StrCrv, ArrCrvTax
ReDim ArrCrvTax(0)
Dim ArrTrimSrf
For i=0 To IntUInt-2
For j=0 To intVInt-2
'ReDim Preserve ArrCrvTax(e)
ReDim Preserve ArrPlanSrf(k+1)
arrpanel= array(arrPt(i,j), arrPt(i+1, j), arrPt(i, j+1), arrPt(i, j))
strCrvTax= Rhino.addcurve(arrpanel, 2)
arrBB = Rhino.BoundingBox(StrCrvTax)
'world contruction plane, non specifichiamo nulla come secondo fattore
arrCP = array((arrBB(2)(0)+ arrBB(4)(0))/2,(arrBB(2)(1)+ arrBB(4)(1))/2,(arrBB(2)(2)+arrBB(4)(2))/2)
'media
'2.find distance centerpoint-attractor
dbldist = Rhino.Distance(arrPtAtt,arrCP)
'3.scale according to distance inside thresold
If dbldist < dblscale =" ((dblTdist-dbldist)/(1.02*dblTdist))" strcrvtax=" Rhino.ScaleObject(StrCrvTax,arrCP,array(dblscale,dblscale,dblscale))" strcrvtax =" Rhino.Command(" arrcrvtax =" Rhino.SelectedObjects" arrtrimsrf =" Rhino.SplitBrep(strSrf," strsrf =" Rhino.IntersectBreps(arrTrimSrf(0)" strsrf="ArrTrimSrf(0)" arrpanel=" array(arrPt(i+1,j)," strcrvtax=" Rhino.addcurve(arrpanel," arrbb =" Rhino.BoundingBox(StrCrvTax)" arrcp =" array((arrBB(2)(0)+" dbldist =" Rhino.Distance(arrPtAtt,arrCP)" dblscale =" ((dblTdist-dbldist)/(1*dblTdist))" strcrvtax=" Rhino.ScaleObject(StrCrvTax,arrCP,array(dblscale,dblscale,dblscale))" strcrvtax =" Rhino.Command(" arrcrvtax =" Rhino.SelectedObjects" strcrvtax =" Rhino.ExtrudeCurveStraight(ArrCrvTax(0)," arrtrimsrf =" Rhino.SplitBrep(strSrf," strsrf="ArrTrimSrf(0)">

Thigmotropism

2009-03-09T02:17:00.017+01:00

This is the first attempt to recreate the phenomenon of Thigmotropism. This system of growth is genereted by the physical conctact between a plant organ and a solid object. A directional response caused by a differential growht. I want to improve this model with a larger adherence to the real growth process, for example recreate the influence of the vegetal hormone auxine that causes this behaviour operating locally.

I link also a video releted to this process.

http://www.youtube.com/watch?v=dTljaIVseTc

Option Explicit

'Giacomo Damiani

'Script version domenica 8 marzo 2009 18.52.06

Call Main()

Sub Main()

Dim i, arrcirc, dblparam, dblradius,arrplane

'scelgo una curva intorno alla quale crescere

Dim strCurve: strCurve = Rhino.GetObject("select curve", 4)

If isNull (strCurve) Then Exit Sub

Dim IntNPts: intNPts = Rhino.GetInteger("how many samples?", 100, 50, 500) 'chiedo il dimensionamento

If isNull (intNpts) Then Exit Sub

Call Rhino.EnableRedraw(False)

Dim arrDom: arrDom = Rhino.CurveDomain(strCurve)

ReDim arrCirc(intNpts-1),arrpoints(intNpts-1)

Dim dblstep: dblStep = (arrDom(1)-arrDom(0))/intNPts

Dim arrpt,strpt,arrpt2,arrpte,strpt2, dblradius2, strcurve1,strsrf

ReDim arrpt2(intNpts-1)

ReDim arrpte(intNpts-1)

ReDim arrpt(intNpts-1)

For i=0 To intNPts-1

dblParam = arrDom(0) + i*dblStep

arrPlane = Rhino.CurvePerpFrame(strCurve, dblParam)

dblRadius = 0.5

arrCirc(i) = Rhino.AddCircle(arrPlane, dblRadius)

arrpt(i) = Rhino.EvaluateCurve(strcurve,dblparam)

strpt = Rhino.AddPoint(arrpt(i))

arrpte(i) = Rhino.EvaluateCurve(arrcirc(i),dblparam*50)

arrpt2(i) = Rhino.MoveObject(strpt,arrpt(i),arrpte(i))

'sposto i punti sul cerchio

Call Rhino.Addloftsrf(arrcirc)

Call Rhino.ObjectColor(arrCirc,RGB(255,0,0))

strcurve1 = Rhino.AddInterpCurve(arrpte)

Dim dblparam2, arrplane2

ReDim arrcirc2(intNpts-1)

Dim arrDom2: arrDom2 = Rhino.CurveDomain(strCurve1)

ReDim arrCirc2(intNpts-1)

Dim dblstep2: dblStep2 = (arrDom2(1)-arrDom2(0))/intNPts

'un secondo ciclo per la seconda serie di cerchi nei punti spostati

For i=0 To intNpts-1

dblParam2 = arrDom2(0) + i*dblStep2

arrPlane2 = Rhino.CurvePerpFrame(strCurve1, dblParam2)

dblRadius2 = 2/(i+3)

arrCirc2(i) = Rhino.AddCircle(arrPlane2, dblRadius2)

Call Rhino.AddLoftSrf(arrCirc2)

Call Rhino.ObjectColor(arrCirc2,RGB(0,0,255))

Call Rhino.EnableRedraw(True)

End Sub

Rhizome

2009-03-08T20:04:00.009+01:00

I'm studying Deleuze's Rhizome trying to replicate some principles:1)connection and eterogenity2)multiplicity3)asignificant break4)cartography and decalcomania
i'm still work on it and all the implication it has in architectureI'll give more explanations.. :)

Option Explicit
'Script written by simone cremona
'Script copyrighted by sim_c
'Script version lunedì 8 marzo 2009 15.16.15
Call Main()
Sub Main()
Dim arrCrv: arrCrv=Rhino.GetObjects("select data curves", 4)
Dim strSrf, strSrf0: strSrf0 = Rhino.AddLoftSrf(ArrCrv)
Dim intUInt: intUInt = Rhino.GetInteger("number of U intervals?", 10, 5)
Dim intVInt: intVInt = Rhino.GetInteger("number of V intervals?", 10, 5)
Dim IntNPts: intNPts = Rhino.GetInteger("how many samples for the curves?", 100, 50, 200)
If isNull (intNpts) Then Exit Sub
strSrf=strSrf0(0)
Dim arrUdom, arrVdom, arrpanel
ArrUdom = Rhino.SurfaceDomain(strSrf, 0)
ArrVdom = Rhino.SurfaceDomain(strSrf, 1)
Call Rhino.Print("surface U domain: from " & arrUdom(0) & " to " & arrUdom(1))
Call Rhino.Print("surface V domain: from " & arrVdom(0) & " to " & arrVdom(1))
Dim i, j, arrPt, Upar, Vpar, strFrame, dblUdist, dblVdist
ReDim arrPt(intUint-1, intVint-1)
Call Rhino.EnableRedraw(False)
For i=0 To IntUInt-1
For j=0 To intVInt-1
Upar= arrUdom(0)+i*(arrUdom(1)-arrUdom(0))/(intUInt-1)
Vpar= arrVdom(0)+j*(arrVdom(1)-arrVdom(0))/(intVInt-1)
'evaluating surface at (upar, vpar), it gives a 3d point
arrPt(i,j)=Rhino.EvaluateSurface(strSrf, array(upar, vpar))
'place a point there; describing a surface with loads of points
Call Rhino.addpoint(arrPt(i, j))
Next
Next
Dim ArrPtCurves(), arrPtCurvesC(), ArrCurves1()
ReDim ArrCurves1(intUInt-1)
Dim p, n
For p=0 To IntUInt-1
n=0
ReDim ArrPtCurves(p,n)
For i=0 To IntUInt-1
For j=0 To intVInt-1
If i= (j+p) Then
ReDim Preserve ArrPtCurves (p,n)
ReDim Preserve ArrPtCurvesC (n)
ArrPtCurves (p,n) = ArrPt(i,j)
ArrPtCurvesC(n)= arrPtCurves(p,n)
n=n+1
End If
Next
Next
ArrCurves1(p) = Rhino.AddCurve(arrPtCurvesC)
If n>2 Then
Dim dblRadius, q, ArrCirc, ArrPts
Dim arrDom: arrDom = Rhino.CurveDomain(arrCurves1(p))
Dim dblparam, arrCrvData, dblStep, arrPlane
ReDim arrCirc(intNpts)
dblStep = (arrDom(1)-arrDom(0))/(intNPts+1)
For q=0 To intNPts
dblParam = arrDom(0) + q*dblStep
arrCrvData = Rhino.CurveCurvature (arrCurves1(p), dblParam)
arrPlane = Rhino.CurvePerpFrame(arrCurves1(p), dblParam)
If Not isNull (arrCrvData) Then
dblRadius= 8/arrCrvData(3)
Else
dblRadius = 1
End If
arrCirc(q) = Rhino.AddCircle(arrPlane, dblRadius)
Next
Call Rhino.AddLoftSrf(arrCirc)
End If
Next
Dim ArrCurves2()
ReDim ArrCurves2(intUInt-1)
For p=0 To IntUInt-1
n=0
ReDim ArrPtCurves(p,n)
For i=1 To IntUInt-1
For j=0 To intVInt-1
If (i+p)=j Then
ReDim Preserve ArrPtCurves(p,n)
ReDim Preserve ArrPtCurvesC (n)
ArrPtCurves (p,n) = ArrPt(i,j)
ArrPtCurvesC(n)= arrPtCurves(p,n)
n=n+1
End If
Next
Next
ArrCurves2(p) = Rhino.AddCurve(arrPtCurvesC)
If n>2 Then
arrDom = Rhino.CurveDomain(arrCurves2(p))
ReDim arrCirc(intNpts)
dblStep = (arrDom(1)-arrDom(0))/(intNPts+1)
For q=0 To intNPts
dblParam = arrDom(0) + q*dblStep
arrCrvData = Rhino.CurveCurvature (arrCurves2(p), dblParam)
arrPlane = Rhino.CurvePerpFrame(arrCurves2(p), dblParam)
If Not isNull (arrCrvData) Then
dblRadius= 8/arrCrvData(3)
Else
dblRadius = 1
End If
arrCirc(q) = Rhino.AddCircle(arrPlane, dblRadius)
Next
Call Rhino.AddLoftSrf(arrCirc)
End If
Next
Dim ArrCurves3()
ReDim ArrCurves3(2*(intUInt-1))
For p=0 To 2*(IntUInt-1)
n=0
ReDim ArrPtCurves(p,n)
For i=0 To IntUInt-1
For j=0 To intVInt-1
If i+j=p Then
ReDim Preserve ArrPtCurves (p,n)
ReDim Preserve ArrPtCurvesC (n)
ArrPtCurves (p,n) = ArrPt(i,j)
ArrPtCurvesC(n)= arrPtCurves(p,n)
n=n+1
End If
Next
Next
ArrCurves3(p) = Rhino.AddCurve(arrPtCurvesC)
If n>2 Then
arrDom = Rhino.CurveDomain(arrCurves3(p))
ReDim arrCirc(intNpts)
dblStep = (arrDom(1)-arrDom(0))/(intNPts+1)
For q=0 To intNPts
dblParam = arrDom(0) + q*dblStep
arrCrvData = Rhino.CurveCurvature (arrCurves3(p), dblParam)
arrPlane = Rhino.CurvePerpFrame(arrCurves3(p), dblParam)
If Not isNull (arrCrvData) Then
dblRadius= 8/arrCrvData(3)
Else
dblRadius = 1
End If
arrCirc(q) = Rhino.AddCircle(arrPlane, dblRadius)
Next
Call Rhino.AddLoftSrf(arrCirc)
End If
Next
Call Rhino.HideObject(strsrf)
Dim strCrvTax
Dim Stratt: strAtt = Rhino.GetObject("select attractor point",1)
Dim arrPtAtt: arrPtAtt = Rhino.PointCoordinates(strAtt)
'imput theresold distance
Dim dblTdist: dblTdist=Rhino.Getreal("threshold distance?",30,10)
'scale objects if inside theresold:
Dim arrBB,arrCP,dbldist,dblscale'center point
Dim k
Dim ArrPlanSrf
ReDim ArrPlanSrf(k)
For i=0 To IntUInt-2
For j=0 To intVInt-2
ReDim Preserve ArrPlanSrf(k+1)
arrpanel= array(arrPt(i,j), arrPt(i+1, j), arrPt(i, j+1), arrPt(i, j))
strCrvTax= Rhino.addcurve(arrpanel, 2)
ArrPlanSrf= Rhino.Addplanarsrf(array(strCrvTax))
For k=0 To ubound (ArrPlanSrf)
'1.find buonding box of object
arrBB = Rhino.BoundingBox(ArrPlanSrf(k))
'world contruction plane, non specifichiamo nulla come secondo fattore
arrCP = array((arrBB(2)(0)+ arrBB(4)(0))/2,(arrBB(2)(1)+ arrBB(4)(1))/2,(arrBB(2)(2)+arrBB(4)(2))/2)
'media
'2.find distance centerpoint-attractor
dbldist = Rhino.Distance(arrPtAtt,arrCP)
'3.scale according to distance inside thresold
If dbldist > dblTdist Then
dblscale = (1-(dbldist-dblTdist)/dbldist)
Call Rhino.ScaleObject(ArrPlanSrf(k),arrCP,array(dblscale,dblscale,dblscale))
End If
Next
arrpanel= array(arrPt(i+1,j), arrPt(i+1, j+1), arrPt(i, j+1), arrPt(i+1, j))
strCrvTax= Rhino.addcurve(arrpanel, 2)
ArrPlanSrf= Rhino.Addplanarsrf(array(strCrvTax))
For k=0 To ubound (ArrPlanSrf)
'1.find buonding box of object
arrBB = Rhino.BoundingBox(ArrPlanSrf(k))
'world contruction plane, non specifichiamo nulla come secondo fattore
arrCP = array((arrBB(2)(0)+ arrBB(4)(0))/2,(arrBB(2)(1)+ arrBB(4)(1))/2,(arrBB(2)(2)+arrBB(4)(2))/2)
'media
'2.find distance centerpoint-attractor
dbldist = Rhino.Distance(arrPtAtt,arrCP)
'3.scale according to distance inside thresold
If dbldist > dblTdist Then
dblscale = (1-(dbldist-dblTdist)/dbldist)
Call Rhino.ScaleObject(ArrPlanSrf(k),arrCP,array(dblscale,dblscale,dblscale))
End If
Next
Next
Next
'Call Rhino.EnableRedraw(False)
Call Rhino.EnableRedraw(True)

Today NAO saved me

2009-02-20T20:02:00.006+01:00

This graasshopper definition create a self turning tower in elliptic base
Thanks to Jonas of NAO for the fantastic tutorial
It's just an exercise, but the result is very nice

Surface tesselation

2009-02-19T12:58:00.010+01:00

Hey everyone! I made some experiments with surface tesselation, here they are!

I tried different kind of tesselation on a ruled surface and on a spiral loft surface, the script which made the spiral has been published yet so I won't bother you with that (you can just scroll down to see some examples)..

First of all a simple script that use the u & v surface's parameters to tesselate them with simple 2nd grade lofted curves (I am nesting words). It is very similar to the one we made in class, so, no surprises..

Option Explicit

' . Script written by Vincenzo Reale

' . univin@libero.it

'Script version lunedì 16 febbraio 2009 15.15.59

Call Main()

Sub Main()

'strline = rhino.GetObject("get line for extrusion lenght")

'this is for the following part, uncheck later

'input surface

Dim strSurf: strSurf = rhino.GetObject("select a surface",8)

Dim Intuint : intuInt = rhino.GetInteger("n. of U intervals?",10,10)

Dim Intvint : intvInt = rhino.GetInteger("n. of v intervals?",10,10)

'get surface domain (u and v), dobbiamo dirgli la direzione

Call rhino.EnableRedraw (False)

Dim arrUdom, arrVdom

arrUdom = Rhino.SurfaceDomain(strsurf,0)

arrVdom = Rhino.SurfaceDomain(strsurf,1)

Dim i, j

Dim arrPt, upar, vpar

Dim srfframe

ReDim arrPt(intUint-1, intVint-1)

' evaluating points on surface

For i = 0 To Intuint-1

For j = 0 To intvint-1

'calculating u and v steps

upar = arrudom(0) + i*(arrudom(1)-arrudom(0))/(intuint-1)

vpar = arrudom(0) + j*(arrvdom(1)-arrvdom(0))/(intvint-1)

arrpt (i,j) = rhino.EvaluateSurface(strsurf,array(upar,vpar))

' !!! the next part is the one that will be changed during the experiment, so just

' paste the new lines from here....

Dim arrpanel

Dim strcurve1

For i = 0 To Intuint-2

For j = 0 To intvint-2

arrpanel = array (arrpt(i,j),arrpt(i+1,j), arrpt(i,j+1),arrpt(i,j))

strcurve1 = rhino.addcurve(arrpanel,2)

Call rhino.AddPlanarSrf(array(strcurve1))

arrpanel = array (arrpt(i+1,j), arrpt(i+1,j+1), arrpt(i,j+1),arrpt(i+1,j))

strcurve1 = rhino.addcurve(arrpanel,2)

Call rhino.AddPlanarSrf(array(strcurve1))

' ...to here !!!!!

Call rhino.DeleteObject(strsurf) 'you can switch this off

Call rhino.EnableRedraw(True)

End Sub

Then, the surface is tessellated with hexagonal cells. Perimeter of hexagons are extruded to look like honeycomb. Extrusion height is taken from a line you have to draw! (so don't forget unchecking the line part)

In this case there are no planar surfaces that can be created with that six points (they are not on a plane) so do you know what is the right command to create three dimensional surfaces with six points or a three dimensional border? By the way different inclinations of the extrusion line path will give you different results (the first is perpendicular to the base plane, se second parallel to it). Possibilities: the extrusion path may be linked either with the perpendicular vector of the surface in any point, or with one or more influence points.

just put into the first scritp this:

Dim arrpanel

Dim strcurve1

For i = 1 To Intuint-3 Step 4

For j = 1 To intvint-4 Step 2

'this is the hexagonal tesselation point, you can imagine them on a grid

arrpanel = array (arrpt(i,j),arrpt(i+1,j), arrpt(i+2,j+1),arrpt(i+1,j+2),arrpt(i,j+2),arrpt(i-1,j+1),arrpt(i,j))

strcurve1 = rhino.addcurve(arrpanel,1)

Call rhino.ExtrudeCurve(strcurve1,strline)

Call rhino.AddPlanarSrf(array(strcurve1))

For i = 3 To Intuint-3 Step 4

For j = 2 To intvint-4 Step 2

arrpanel = array (arrpt(i,j),arrpt(i+1,j), arrpt(i+2,j+1),arrpt(i+1,j+2),arrpt(i,j+2),arrpt(i-1,j+1),arrpt(i,j))

strcurve1 = rhino.addcurve(arrpanel,1)

Call rhino.ExtrudeCurve(strcurve1,strline)

Call rhino.AddPlanarSrf(array(strcurve1))

Now, third tesselation is similar to the previous one but the nesting is different, in this case you have three loops

Dim arrpanel

Dim strcurve1

For i = 0 To Intuint-3 Step 3

For j = 0 To intvint-3 Step 3

'this is the other nesting, draw it on a grid to undestand how it works

arrpanel = array (arrpt(i,j),arrpt(i+1,j), arrpt(i+2,j+1),arrpt(i+2,j+2),arrpt(i+1,j+2),arrpt(i,j+1),arrpt(i,j))

strcurve1 = rhino.addcurve(arrpanel,1)

Call rhino.ExtrudeCurve(strcurve1,strline)

For i = 2 To Intuint-1 Step 3

For j = 1 To intvint-2 Step 3

arrpanel = array (arrpt(i,j),arrpt(i+1,j), arrpt(i+2,j+1),arrpt(i+2,j+2),arrpt(i+1,j+2),arrpt(i,j+1),arrpt(i,j))

strcurve1 = rhino.addcurve(arrpanel,1)

Call rhino.ExtrudeCurve(strcurve1,strline)

For i = 1 To Intuint-2 Step 3

For j = 2 To intvint-1 Step 3

arrpanel = array (arrpt(i,j),arrpt(i+1,j), arrpt(i+2,j+1),arrpt(i+2,j+2),arrpt(i+1,j+2),arrpt(i,j+1),arrpt(i,j))

strcurve1 = rhino.addcurve(arrpanel,1)

Call rhino.ExtrudeCurve(strcurve1,strline)

Fourth, variation with three planar surfaces interpolated with the hexagonal points (Same problem, how to make a non planar surface from six points? And by the way i CAN'T FIND how to pipe a curve!)

Dim arrpanel, arrcrvpoint

Dim strcurve1, strcurve2, strcurve3, strcurve4

For i = 0 To Intuint-3 Step 3

For j = 0 To intvint-3 Step 3

' i take the hexagon border point and I made two dimensional curves with three points at time as control points

arrpanel = array (arrpt(i,j),arrpt(i+1,j), arrpt(i+2,j+1),arrpt(i+2,j+2),arrpt(i+1,j+2),arrpt(i,j+1),arrpt(i,j))

arrcrvpoint= array(arrpanel(0), arrpanel(1),arrpanel(4),arrpanel(0))

strcurve1 = rhino.addcurve(arrpanel,1)

strcurve2 = rhino.AddCurve(arrcrvpoint,2)

arrcrvpoint= array(arrpanel(2), arrpanel(3),arrpanel(0),arrpanel(2))

strcurve3 = rhino.AddCurve(arrcrvpoint,2)

arrcrvpoint= array(arrpanel(4), arrpanel(5),arrpanel(2),arrpanel(4))

strcurve4 = rhino.AddCurve(arrcrvpoint,2)

Call Rhino.AddPlanarSrf (array(strcurve2,strcurve3,strcurve4))

Call rhino.ExtrudeCurve(strcurve1,strline)

For i = 2 To Intuint-3 Step 3

For j = 1 To intvint-3 Step 3

arrpanel = array (arrpt(i,j),arrpt(i+1,j), arrpt(i+2,j+1),arrpt(i+2,j+2),arrpt(i+1,j+2),arrpt(i,j+1),arrpt(i,j))

arrcrvpoint= array(arrpanel(0), arrpanel(1),arrpanel(4),arrpanel(0))

strcurve1 = rhino.addcurve(arrpanel,1)

strcurve2 = rhino.AddCurve(arrcrvpoint,2)

arrcrvpoint= array(arrpanel(2), arrpanel(3),arrpanel(0),arrpanel(2))

strcurve3 = rhino.AddCurve(arrcrvpoint,2)

arrcrvpoint= array(arrpanel(4), arrpanel(5),arrpanel(2),arrpanel(4))

strcurve4 = rhino.AddCurve(arrcrvpoint,2)

Call Rhino.AddPlanarSrf (array(strcurve2,strcurve3,strcurve4))

call rhino.ExtrudeCurve(strcurve1,strline)

For i = 1 To Intuint-3 Step 3

For j = 2 To intvint-2 Step 3

arrpanel = array (arrpt(i,j),arrpt(i+1,j), arrpt(i+2,j+1),arrpt(i+2,j+2),arrpt(i+1,j+2),arrpt(i,j+1),arrpt(i,j))

arrcrvpoint= array(arrpanel(0), arrpanel(1),arrpanel(4),arrpanel(0))

strcurve1 = rhino.addcurve(arrpanel,1)

strcurve2 = rhino.AddCurve(arrcrvpoint,2)

arrcrvpoint= array(arrpanel(2), arrpanel(3),arrpanel(0),arrpanel(2))

strcurve3 = rhino.AddCurve(arrcrvpoint,2)

arrcrvpoint= array(arrpanel(4), arrpanel(5),arrpanel(2),arrpanel(4))

strcurve4 = rhino.AddCurve(arrcrvpoint,2)

Call Rhino.AddPlanarSrf (array(strcurve2,strcurve3,strcurve4))

call rhino.ExtrudeCurve(strcurve1,strline)

At last a triangular tesselation within a planar curve (2°grade) tasselation which creates holes dipending on the distance between the tassel and the control point. You can change the threshold for the point influence and also choose different behaviour for border panels (I made some notes). I wonder if there is a way to create holes directly to the three dimensional surface instead on the triangolar tassels .

Nevertheless, here is the script

Option Explicit

' . Script written by Vincenzo Reale

' . univin@libero.it

'Script version since mercoledì 18 febbraio 2009 23.40.00 to very very late at night

Call Main()

Sub Main()

' get a surface

Dim strSurf: strSurf = rhino.GetObject("select a surface",8)

Dim Intuint : intuInt = rhino.GetInteger("n. of U intervals?",10,2)

Dim Intvint : intvInt = rhino.GetInteger("n. of v intervals?",10,2)

'get point attractor

Dim strAtt: strAtt = Rhino.GetObject("select attractor point",1)

Dim arrpatt: arrpAtt = Rhino.PointCoordinates(stratt)

Dim dblTdist: dblTdist = Rhino.GetReal("threshold distance?", 2,1)

Call rhino.EnableRedraw (False)

Dim arrUdom, arrVdom

arrUdom = Rhino.SurfaceDomain(strsurf,0)

arrVdom = Rhino.SurfaceDomain(strsurf,1)

Dim i, j

Dim arrPt, upar, vpar

ReDim arrPt(intUint-1 , intVint-1)

For i = 0 To Intuint-1

For j = 0 To intvint-1

'calculating u and v steps

upar = arrudom(0) + i*(arrudom(1)-arrudom(0))/(intuint-1)

vpar = arrudom(0) + j*(arrvdom(1)-arrvdom(0))/(intvint-1)

arrpt (i,j) = rhino.EvaluateSurface(strsurf,array(upar,vpar))

Dim arrpanel

Dim strcurvepanel, strcurvecircle

Dim arrsurfpanel, arrsurfcircle, arrlateral

Dim strcut, arrCP, dbldist1, dblscale

For i = 0 To Intuint-2

For j = 0 To intvint-2

'arrpanel is the triangular tesselation, strcurve panel is the curve that trim the first tesselation with rhino.splitbrep

' the scale is weighted with the distance of the surface central point (area centroid) and the threshold

arrpanel = array (arrpt(i,j),arrpt(i+1,j), arrpt(i,j+1),arrpt(i,j))

strcurvepanel = rhino.addcurve(arrpanel,1)

strcurvecircle = rhino.addcurve (arrpanel,2)

arrsurfpanel = rhino.addsrfpt(arrpanel)

arrCP = Rhino.CurveAreaCentroid (strcurvepanel)

dbldist1 = rhino.distance(arrcp(0),arrpatt)

If dblDist1 <>

dblscale = 1-(dbltdist-dbldist1)/dbltdist

Call rhino.scaleobject(strcurvecircle,arrCP(0),array(dblscale,dblscale,dblscale))

End If

'if you put this part from here...

arrsurfcircle = rhino.AddPlanarSrf(array(strcurvecircle))

strcut = Rhino.SplitBrep(arrsurfpanel,arrsurfcircle(0),True)

Call rhino.deleteobject (arrsurfcircle(0))

' Call rhino.deleteobject (arrsurfpanel(0))

Call rhino.deleteobject (strcut(0))

Call rhino.deleteobject (strcurvepanel)

Call rhino.deleteobject (strcurvecircle)

' to here inside the if clause you get the surface outside the threshold influence whith holes (this case) or not, first two pics. Do it also in the other loop

For i = 1 To Intuint-1

For j = 0 To intvint-2

arrpanel = array (arrpt(i,j),arrpt(i,j+1), arrpt(i-1,j+1),arrpt(i,j))

strcurvepanel = rhino.addcurve(arrpanel,1)

strcurvecircle = rhino.addcurve (arrpanel,2)

arrsurfpanel = rhino.addsrfpt(arrpanel)

arrCP = Rhino.CurveAreaCentroid (strcurvepanel)

dbldist1 = rhino.distance(arrcp(0),arrpatt)

If dblDist1 <>

dblscale = 1-(dbltdist-dbldist1)/dbltdist

Call rhino.scaleobject(strcurvecircle,arrCP(0),array(dblscale,dblscale,dblscale))

End If

arrsurfcircle = rhino.AddPlanarSrf(array(strcurvecircle))

strcut = Rhino.SplitBrep(arrsurfpanel,arrsurfcircle(0),True)

Call rhino.deleteobject (arrsurfcircle(0))

' Call rhino.deleteobject (arrsurfpanel(0))

Call rhino.deleteobject (strcut(0))

Call rhino.deleteobject (strcurvepanel)

Call rhino.deleteobject (strcurvecircle)

Call rhino.deleteobject(strsurf)

Call rhino.enableredraw(True)

End Sub

phyllotaxis pavilion

2009-02-18T16:19:00.002+01:00

The code realizes a pavilion along a selected curve. Pavilion internal radius is influenced by the distance between the curve and an attractor point. Holes-size is related to the distance between the curve and another attractor point (placed in this case near curve's midpoint). In this way holes become smaller moving towards curve's midpoint.

Option Explicit
'Script written by andrea bugli
' "shift" on http://andbug.blogspot.com
'Script version venerdì 20 febbraio 2009 19.54.31

Call fibonaccipavilion
Sub fibonaccipavilion

Dim strBpts

Dim arrcircle, strN
strN = 240
Dim strcurve: strcurve = rhino.GetObject("select a curve", 4, True, True)
Dim arrPoints: arrPoints = rhino.DivideCurve(strcurve, strN, False, True)

ReDim arrcircle(ubound(arrPoints))

'this point influences pavilion radius
Dim ptparam1: ptparam1 = rhino.GetObject("select curve attractor point")
Dim ptcoord1: ptcoord1 = rhino.PointCoordinates(ptparam1)

'this point influences holes size
Dim ptparam2: ptparam2 = rhino.GetObject("select holes attractor point")
Dim ptcoord2: ptcoord2 = rhino.PointCoordinates(ptparam2)

Dim i
Dim ptrot
Dim pt
Dim ptcurve
ReDim ptrot(ubound(arrPoints))
rhino.EnableRedraw(False)

For i = 0 To ubound(arrPoints)

Dim strPoncurve: strPoncurve = rhino.CurveClosestPoint(strcurve, arrPoints(i))
Dim strframe: strframe = rhino.Curveperpframe(strcurve, strPoncurve)
Dim tang: tang = rhino.curvetangent(strcurve, strPoncurve)
Dim dist: dist = rhino.Distance(arrPoints(i), ptcoord1)
Dim dist2: dist2 = rhino.Distance(arrPoints(i), ptcoord2)

'create the tube on which are placed my points
arrcircle(i) = rhino.addcircle(strframe, 60/dist)

ptcurve = rhino.CurveStartPoint(arrcircle(i))
pt = rhino.addpoint(ptcurve)

'points are rotated by a definited angle
ptrot(i) = rhino.RotateObject(pt, arrPoints(i), 137.52*i, tang, True)

rhino.Deleteobject(pt)

Next

Dim strFace1
Dim strHole1
Dim arrHoleSrf1
Dim arrSrfBrep1
Dim centerPt1
Dim dblDist1

Dim strFace2
Dim strHole2
Dim arrHoleSrf2
Dim arrSrfBrep2
Dim centerPt2
Dim dblDist2

Dim strLine
Dim strPlaneLine
Dim strBaseCrv

For i = 0 To ubound(ptrot)-13

'create triangular face between points
strFace1 = rhino.addSrfPt(array(rhino.PointCoordinates(ptrot(i)), rhino.PointCoordinates(ptrot(i+8)), rhino.PointCoordinates(ptrot(i+5)), rhino.PointCoordinates(ptrot(i))))

'create a curve on the triangular face
strHole1 = rhino.addcurve(array(rhino.PointCoordinates(ptrot(i)), rhino.PointCoordinates(ptrot(i+8)), rhino.PointCoordinates(ptrot(i+5)), rhino.PointCoordinates(ptrot(i))), 2)
centerPt1 = rhino.curveAreaCentroid(strHole1)
dblDist1 = rhino.Distance(ptcoord2, centerPt1(0))

'if distance between centerPt1 and second attractor point is bigger than a definited amount, scale curve by means of
'distance and make a hole in the triangular face. if distance is smaller, leave face intact
If Not (1-8/dblDist1<0.2) Then

strHole1 = rhino.ScaleObject(strHole1, centerPt1(0), array(1-8/dblDist1, 1-8/dblDist1, 1-8/dblDist1))
arrHoleSrf1 = rhino.addPlanarSrf(array(strHole1))
arrSrfBrep1 = Rhino.SplitBrep (strFace1, arrHoleSrf1(0), True)
Call rhino.DeleteObject(arrHoleSrf1(0))
Call rhino.DeleteObject(arrSrfBrep1(0))

End If

Call rhino.deleteObject(strHole1)

'------------------

'create triangular face between points
strFace2 = rhino.addSrfPt(array(rhino.PointCoordinates(ptrot(i+5)), rhino.PointCoordinates(ptrot(i+8)), rhino.PointCoordinates(ptrot(i+13)), rhino.PointCoordinates(ptrot(i+5))))

'create a curve on the triangular face
strHole2 = rhino.addcurve(array(rhino.PointCoordinates(ptrot(i+5)), rhino.PointCoordinates(ptrot(i+8)), rhino.PointCoordinates(ptrot(i+13)), rhino.PointCoordinates(ptrot(i+5))), 2)
centerPt2 = rhino.curveAreaCentroid(strHole2)
dblDist2 = rhino.Distance(ptCoord2, centerPt2(0))

'if distance between centerPt2 and second attractor point is bigger than a definited amount, scale curve by means of
'distance and make a hole in the triangular face. if distance is smaller, leave face intact
If Not (1-8/dblDist2<0.2) Then

strHole2 = rhino.ScaleObject(strHole2, centerPt2(0), array(1-8/dblDist2, 1-8/dblDist2, 1-8/dblDist2))
arrHoleSrf2 = rhino.addPlanarSrf(array(strHole2))
arrSrfBrep2 = Rhino.SplitBrep (strFace2, arrHoleSrf2(0), True)
Call rhino.DeleteObject(arrHoleSrf2(0))
Call rhino.DeleteObject(arrSrfBrep2(0))

End If

Call rhino.DeleteObject(strHole2)

Next

'create a tube on each side of the triangle
For i = 0 To ubound(ptrot)-13

strLine = rhino.addline(rhino.PointCoordinates(ptrot(i)), rhino.PointCoordinates(ptrot(i+8)))
strPlaneLine = rhino.PlaneFromNormal(rhino.PointCoordinates(ptrot(i)), rhino.VectorCreate(rhino.PointCoordinates(ptrot(i)), rhino.PointCoordinates(ptrot(i+8))))
strBaseCrv = rhino.addcircle(strPlaneLine, 0.05)
Call rhino.AddSweep1(strLine, strBaseCrv)

strLine = rhino.addline(rhino.PointCoordinates(ptrot(i)), rhino.PointCoordinates(ptrot(i+5)))
strPlaneLine = rhino.PlaneFromNormal(rhino.PointCoordinates(ptrot(i)), rhino.VectorCreate(rhino.PointCoordinates(ptrot(i)), rhino.PointCoordinates(ptrot(i+5))))
strBaseCrv = rhino.addcircle(strPlaneLine, 0.05)
Call rhino.AddSweep1(strLine, strBaseCrv)

strLine = rhino.addline(rhino.PointCoordinates(ptrot(i+5)), rhino.PointCoordinates(ptrot(i+8)))
strPlaneLine = rhino.PlaneFromNormal(rhino.PointCoordinates(ptrot(i+5)), rhino.VectorCreate(rhino.PointCoordinates(ptrot(i+5)), rhino.PointCoordinates(ptrot(i+8))))
strBaseCrv = rhino.addcircle(strPlaneLine, 0.05)
Call rhino.AddSweep1(strLine, strBaseCrv)

Next

call rhino.DeleteObjects(arrcircle)

Call rhino.DeleteObjects(ptrot)

rhino.enableredraw(True)

End Sub

2009-02-08T17:11:00.011+01:00

This is a very simple script that creates 3 different elix entwining. The diameters depend on the curve's curvature, directly or not.

Users can define the number of levels.

enjoy!

sim_c

Option Explicit

'Script written by

'Script copyrighted by

'Script version sabato 7 febbraio 2009 18.00.30

Call Main()

Sub Main()

Dim intNPts: intNPts= Rhino.GetInteger("how many points?", 15, 10, 20)

Dim i, arrPts, arrPtC, strCurve

ReDim arrPts(intNPts-1)

ReDim arrPtC (intNPts-1)

For i=0 To (intNPts-8)

arrPtC(i) = array(10*cos(i),10*sin(i),40*sqr(i))

arrPts(i)= Rhino.addpoint(arrPtC(i))

For i= intNPts-8 To (intNPts-1)

arrPtC(i) = array(10*cos(i)/((i+1)/5),10*sin(i)/((i+1)/5),40*sqr(i))

arrPts(i)= Rhino.addpoint(arrPtC(i))

strCurve = Rhino.AddInterpCurve (arrPtC)

Dim arrDom: arrDom = Rhino.CurveDomain(strCurve)

Dim dblparam, arrCrvData, dblStep, arrPlane, arrCircle, j

Dim dblRadius

ReDim arrCirc(intNpts)

dblStep = (arrDom(1)-arrDom(0))/intNPts

For j=0 To intNPts

dblParam = arrDom(0) + j*dblStep

arrCrvData = Rhino.CurveCurvature (strCurve, dblParam)

arrPlane = Rhino.CurvePerpFrame(strCurve, dblParam)

If Not isNull (arrCrvData) Then

dblRadius= arrCrvData(3)/10

Else

dblRadius = 0.1

End If

arrCirc(j) = Rhino.AddCircle(arrPlane, dblRadius)

'strCurveCrv = Rhino.AddInterpCurve(arrCirc)

Call Rhino.AddLoftSrf(arrCirc)

Dim arrPts1, arrPtC1, strCurve1, n

ReDim arrPts1(intNPts-1)

ReDim arrPtC1 (intNPts-1)

For n=0 To (intNPts-1)

arrPtC1(n) = array(15*-cos(n)/(n+1),15*-sin(n)/(n+1),11*(n))

arrPts1(n)= Rhino.addpoint(arrPtC1(n))

strCurve1 = Rhino.AddInterpCurve (arrPtC1)

Dim arrDom1: arrDom1 = Rhino.CurveDomain(strCurve1)

Dim dblparam1, arrCrvData1, dblStep1, arrPlane1, arrCircle1, m

Dim dblRadius1

ReDim arrCirc1(intNpts)

dblStep1 = (arrDom1(1)-arrDom1(0))/intNPts

For m=0 To intNPts

dblParam1 = arrDom1(0) + m*dblStep1

arrCrvData1 = Rhino.CurveCurvature (strCurve1, dblParam1)

arrPlane1 = Rhino.CurvePerpFrame(strCurve1, dblParam1)

If Not isNull (arrCrvData1) Then

dblRadius1= 175/arrCrvData1(3)

Else

dblRadius1 = 50

End If

arrCirc1(m) = Rhino.AddCircle(arrPlane1, dblRadius1)

'strCurveCrv = Rhino.AddInterpCurve(arrCirc)

Call Rhino.AddLoftSrf(arrCirc1)

Dim p, arrPts2, arrPtC2, strCurve2

ReDim arrPts2(intNPts-1)

ReDim arrPtC2 (intNPts-1)

For p=0 To (intNPts-8)

arrPtC2(p) = array(10*-cos(p),10*-sin(p),40*sqr(p))

arrPts2(p)= Rhino.addpoint(arrPtC(p))

For p= intNPts-8 To (intNPts-1)

arrPtC2(p) = array(10*-cos(p)/((p+1)/5),10*-sin(p)/((p+1)/5),40*sqr(p))

arrPts2(p)= Rhino.addpoint(arrPtC(p))

strCurve2 = Rhino.AddInterpCurve (arrPtC2)

Dim arrDom2: arrDom2 = Rhino.CurveDomain(strCurve2)

Dim dblparam2, arrCrvData2, dblStep2, arrPlane2, arrCircle2, q

Dim dblRadius2

ReDim arrCirc2(intNpts)

dblStep2 = (arrDom2(1)-arrDom2(0))/intNPts

For q=0 To intNPts

dblParam2 = arrDom2(0) + q*dblStep2

arrCrvData2 = Rhino.CurveCurvature (strCurve2, dblParam2)

arrPlane2 = Rhino.CurvePerpFrame(strCurve2, dblParam2)

If Not isNull (arrCrvData2) Then

dblRadius2= arrCrvData2(3)/10

Else

dblRadius2 = 0.1

End If

arrCirc2(q) = Rhino.AddCircle(arrPlane2, dblRadius2)

'strCurveCrv = Rhino.AddInterpCurve(arrCirc)

Call Rhino.AddLoftSrf(arrCirc2)

Call Rhino.EnableRedraw(True)

End Sub