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!