L-system [test]

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!

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

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

Next

Next

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

Next

Next

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

Next

Next

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

Next

Next

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

Next

Next

Call rhino.DeleteObject(strsurf)

Call rhino.EnableRedraw(True)

End Sub