This script allow you to generate loftsurfaces which follow the curvature of a predesigned line. Surface dimension is scaled with the inverse radius of line curvature and is tangent to the line. Changing the function in the script will give you different results.

Some screenshots

Option Explicit

' . Script written by Vincenzo Reale & Alessandro Zomparelli

' . edited by Vincenzo Reale

' . univin@libero.it

'Script version martedì 3 febbraio 2009 22.54.05

Call Main()

Sub Main()

Dim arrPts

Dim i, intNumber

intNumber = rhino.GetInteger("how many points?",50,10,200)

Call Rhino.EnableRedraw (False)

ReDim arrPts (intnumber-1)

For i=0 To Ubound (arrPts)

'Look this is a very important part! You can change it if u want!

arrPts (i) = array (cos(i),sin(i),i)

Call Rhino.AddPoint(arrPts(i))

Next

Call Rhino.addInterpCurve (arrPts)

Dim strCurve

strCurve = Rhino.AddInterpCurve (arrPts)

Call curveLoft(strCurve)

Call rhino.EnableRedraw(True)

End Sub

Sub curveLoft(strCurve)

If isnull(strCurve) Then Exit Sub

Dim intnPts: intnPts = 100 'you can change that or ask user if you want

If isnull(intnPts) Then Exit Sub

Dim arrDom: arrDom = Rhino.curvedomain(strCurve)

Dim i, dblParam, arrCrvData

Dim intnCount

intnCount=0

Dim arrPts(), arrCirc, dblStep, arrPlane, dblRad, vectorUnit

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

ReDim arrcirc(intNpts)

For i = 0 To intNpts

dblParam = arrDom(0)+i*dblStep

arrCrvData = Rhino.CurveCurvature(strCurve,dblParam)

arrPlane = Rhino.CurvePerpFrame(strCurve,dblParam)

If Not Isnull (arrCrvData) Then

dblRad = 10/arrCrvData(3) 'this is also changeable

Else

dblRad = 10 'so this

End If

vectorUnit = rhino.VectorUnitize (arrCrvData(4))

vectorUnit = rhino.VectorScale(vectorUnit,-dblRad)

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

Call rhino.MoveObject(arrCirc(i),array(0,0,0),vectorUnit)

Next

Call Rhino.AddLoftSrf(arrCirc)

End Sub

This script just generates random points tied on a virtual spherical surface.

We just put polar coordinates of a sphere surface in the random addpoint command, you can choose the number of the points and the maximum distance between two point for a line to be drawn linking them.

A pic!

Option Explicit

' . Script written by Vincenzo Reale & Mario Da Deppo

' . univin@libero.it

'Script version mercoledì 4 febbraio 2009 23.42.11

Call Main()

Sub Main()

Dim intNpt: intNpt = Rhino.GetInteger("how many points?",50,50,500):

Dim dblDist: dblDist = Rhino.GetReal("minimum distance?",100,5,100)

Dim dbla,dblfi

Call rhino.EnableRedraw(False)

Dim i,j, dblPointDist()

Dim arrPts: ReDim arrPts(intNpt-1)

Dim arrPtsc: ReDim arrPtsc(intNpt-1)

Dim arrend

arrend = rdlines (arrPtsc,arrPts,dblPointDist,i,j,dblDist,intNpt,dbla,dblfi)

Call rhino.EnableRedraw(True)

End Sub

Function rdlines (arrPtsc,arrPts, dblPointDist,i,j,dblDist,intNpt,a,fi)

'Look I can pass variable with different names

Dim intCount, intMax

intCount = 0

Dim arrlines()

For i = 0 To intnpt-1

a=rnd*2*pi

fi=rnd*pi

arrPts(i) = Rhino.AddPoint(array(100*cos(a)*cos(fi),100*cos(a)*sin(fi),100*sin(a))) 'you can change the radius or let the user choose it

arrPtsc(i) = Rhino.PointCoordinates(arrpts(i))

Next

For i = 0 To Ubound(arrPts)

For j = 0 To i

If i <> j Then

ReDim Preserve dblPointDist(intCount)

dblPointDist (intcount)= rhino.Distance(arrPtsc(i),arrPtsc(j))

If dblPointDist (intcount) <>

ReDim Preserve arrLines(intCount)

arrLines(intCount) = rhino.AddLine (arrPtsc(i),arrPtsc(j))

intCount = intCount+1

End If

End If

Next

Next

For i = 0 To intcount

intmax = rhino.Max(dblPointDist)

Next

If Isarray (arrlines) Then

rdlines = arrlines

Else rndlinesA = Null

End If

End Function

Ha... can't wait to see part 2!

ReplyDeleteNice job guys.

As for the uppermost script I suggest you make a little research about peristalsis (http://en.wikipedia.org/wiki/Peristalsis).

For the other one (the sphere), why don't you try to make solid tubes out of the lines (suggestion: check Pipe command in Rhino), maybe with diameter varying according to length?

We'll check things out on monday!