It's been a hard day's night - Part Two

Here are some fresh new scripts! These are kind of work in progress, suggestions are welcome. The first was about an idea I had before start learning scripting, and it should be a way of mapping field of forces. In this "beta" version I haven't add the vector direction information  yet, and it is certanly possible to improve it. Users have to insert values of intensity and direction of a field and where these values have been registered. The script draw cilinder scaled (radius and height) and coloured (grey to red) proportionally to the intensity of field in defined points. Sounds simple? I spend two nights with it!

You can try to distribute point (but also intensity) with predesigned equation, it was not the purpose but it could be interesting to see what you can get.

You can also tell me if there is a way to render che colour given by rhino, I can't find it now...

And don't forget reporting mistakes!

Option Explicit

'             . Script written by Vincenzo Reale

'             . univin@libero.it

'Script version giovedì 6 febbraio 2009 1.07.53

Call Main()

Sub Main()

Dim arrPtc(),arrField(),arrField2()

Call rhino.print("We will define a field of forces")

Dim i, inTpoint

i=0

Dim dblX,dblY,dblZ

Dim arrpoint(), arrcircle()

Do 

ReDim Preserve arrptc(i)

ReDim Preserve arrField(i)

ReDim Preserve arrField2(i)

ReDim Preserve arrcircle (i)

ReDim Preserve arrpoint(i)

dblX = rhino.GetReal("Insert x coordinate of point n."&(i+1))

If isnull (dblx)  Then Exit Do

dblY = rhino.GetReal("Insert y coordinate of point n."&(i++1))

If isnull (dblY)  Then Exit Do

dblZ = rhino.GetReal("Insert z coordinate of point n."&(i+1))

If isnull (dblZ)  Then Exit Do 

arrptc(i)= array (dblx,dbly,dblz)

Arrfield(i) = rhino.GetReal("Insert field intensity recorded in point n."&(i+1))

If isnull (dblint)  Then Exit Do 'you can insert an equation here

Arrfield2(i) = rhino.GetReal("Insert field direction (degrees) recorded in point n."&(i+1))

If isnull (dbldir)  Then Exit Do

arrpoint(i)= Rhino.AddPoint(arrptc(i))

arrcircle(i)= rhino.AddCircle(Rhino.WorldXYPlane,arrfield(i))

Call rhino.moveobject(arrcircle(i),array(0,0,0),arrptc(i))

intpoint = i

i=i+1

Loop

Dim arrbase(), arrloft1(), arrloft2()

ReDim Preserve arrbase (intpoint)

ReDim Preserve arrloft1 (intpoint)

ReDim Preserve arrloft2 (intpoint)

Dim intmax

intmax = 1

For i=0 To intpoint

If intmax <>

intmax = arrfield (i)

End If

Next

Dim arrmax

ReDim arrmax (2)

arrmax = array (1/intmax*10 , 1/intmax*10, 1/intmax*10)

Dim arrcap

For i= 0 To intpoint

Call rhino.ScaleObject(arrcircle(i),arrptc(i),array(1/intmax/10,1/intmax/10,1/intmax/10)) 

arrbase (i) = rhino.CopyObject(arrcircle(i),arrptc(i),array(arrptc(i)(0),arrptc(i)(1),arrfield(i)/intmax+arrptc(i)(2)))

arrloft1(i) = rhino.addloftsrf(array(arrbase(i),arrcircle(i)))

Call rhino.objectcolor(arrloft1(i),RGB(255-255*arrfield(i)/intmax,0,0))

Call rhino.objectcolor(arrbase(i),RGB(255-255*arrfield(i)/intmax,0,0))

Next

arrcap =  rhino.AddplanarSrf(arrbase) 'Does a command which add a planar surface to a single string object?

For i = 0 To intpoint

Call rhino.objectcolor(arrcap(i),RGB(255-255*arrfield(i)/intmax,0,0))

Next

End Sub

I think surely there is a better way to do it.. We wanted to put 3d cubes (user dimensioned) on a line at an equal distance (equal in u coordinates). The tricky part is compiling an array storing cube's dimensions. Any suggestion to improve it?

Option Explicit

'             . Script written by Vincenzo Reale & Mario Da Deppo

'             . univin@libero.it

'Script version giovedì 5 febbraio 2009 00.33.18

Call Main()

Sub Main()

Dim arrLen

ReDim arrLen(2)

Dim j

For j = 0 To 2

arrLen(j)= rhino.GetReal ("length box edge n."& j)

Next

Call rhino.EnableRedraw (False)

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

If isnull(strCurve) Then Exit Sub

Call rhino.EnableRedraw(False)

Dim intnPts: intnPts = Rhino.GetInteger("how many samples?",3,3,500)

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

For i = 0 To intNpts-1

dblParam = arrDom(0)+i*dblStep

arrCrvData = Rhino.CurveCurvature(strCurve,dblParam) 

Dim arrbox

ReDim arrbox(7)

'this is the naughty part, any guess?

arrbox(0)=array(arrCrvData(0)(0)-arrlen(0)/2,arrCrvData(0)(1)-arrlen(1)/2,arrCrvData(0)(2)-arrlen(2)/2)

arrbox(1)=array(arrCrvData(0)(0)+arrlen(0)/2,arrCrvData(0)(1)-arrlen(1)/2,arrCrvData(0)(2)-arrlen(2)/2)

arrbox(2)=array(arrCrvData(0)(0)+arrlen(0)/2,arrCrvData(0)(1)+arrlen(1)/2,arrCrvData(0)(2)-arrlen(2)/2)

arrbox(3)=array(arrCrvData(0)(0)-arrlen(0)/2,arrCrvData(0)(1)+arrlen(1)/2,arrCrvData(0)(2)-arrlen(2)/2)

arrbox(4)=array(arrCrvData(0)(0)-arrlen(0)/2,arrCrvData(0)(1)-arrlen(1)/2,arrCrvData(0)(2)+arrlen(2)/2)

arrbox(5)=array(arrCrvData(0)(0)+arrlen(0)/2,arrCrvData(0)(1)-arrlen(1)/2,arrCrvData(0)(2)+arrlen(2)/2)

arrbox(6)=array(arrCrvData(0)(0)+arrlen(0)/2,arrCrvData(0)(1)+arrlen(1)/2,arrCrvData(0)(2)+arrlen(2)/2)

arrbox(7)=array(arrCrvData(0)(0)-arrlen(0)/2,arrCrvData(0)(1)+arrlen(1)/2,arrCrvData(0)(2)+arrlen(2)/2)

Call rhino.AddBox(arrbox)

Next

Call rhino.EnableRedraw (True)

End Sub