What do you do with a couple thousand left over chipboard triangles, some paint, and a little spare time. You make the TETRAbit tabletop. With an A and B side creating a flat surfaced top for function and a contact point base to minimize exposure the resulting plate system is surprisingly strong. Composing three individual images into a pixelated composition, results in a piece that well, I just like. Sometimes a project should just be for the sake of existence. The rhinoscript itself produces a three dimensional model for testing, a 2 dimensional map of the two layers for reference, and laser cut templates which calculates and separates the total number of triangles required to complete the pattern.
| platform: Rhino Script |
| function: Wallscape |
Option Explicit
'Script written by <insert name>
'Script copyrighted by <insert company name>
'Script version Thursday, May 15, 2008 9:24:31 AM
Call Main()
Sub Main()
Dim arrItems, arrValues, arrResults,blnResult,arrClr(2)
arrItems = array("Columns","Rows","Size","Width","Height")
arrValues= array(10,10,2,32,18)
arrResults = Rhino.PropertyListBox (arrItems, arrValues ,,"Sample Settings")
blnResult = Rhino.GetBoolean("ColorCells",array("fillType","outline","hatch","cutTemplate","No","Yes"),array(False,False))
If isNull(blnResult) Then Exit Sub
Dim i
For i = 0 To 2 Step 1
arrClr(i) = arrImageSample(arrResults(0)*4, arrResults(1)*2)
If isNull(arrClr(i)) Then Exit Sub
Next
Call Rhino.EnableRedraw(False)
Call TetraGrid(arrResults(0),arrResults(1),arrResults(3),arrResults(4),arrResults(2),array(array(arrClr(0)(0),arrClr(0)(1),arrClr(0)(2)),array(arrClr(1)(0),arrClr(1)(1),arrClr(1)(2)),array(arrClr(2)(0),arrClr(2)(1),arrClr(2)(2))),blnResult(0),blnResult(1))
Call Rhino.EnableRedraw(True)
End Sub
Function TetraGrid(cols,rows,width,height,size,arrValue,blnHatch,blnCut)
cols=cols*4
TetraGrid = Null
Dim i,j,k,m,n,p,r,s
Dim x,y,z,c, za
Dim pt, ptA
'calculate tetrahedron construction ratio's
x = size
y = size*cos(PI/6)
c= size*.5/sin(PI/3)
z = sqr(x^2-c^2)
'create packed tetrahedron points
ReDim ptT(3),ptTetra(rows*2), ptSet(cols)
ReDim ptB(rows*2),ptSetB(cols)
For i = 0 To cols-1 Step 1
r=0
For j = 0 To rows-1 Step 1
If i Mod(2) Then
ptA = array(x*.5*i,(y+c*1.5)*j+c*1.5,0)
Else
ptA = array(x*.5*i,(y+c*1.5)*j,0)
End If
'type A
pt = array(ptA(0),ptA(1)-c*2,ptA(2))
ptT(0) = array(pt(0),pt(1),pt(2)-z)
ptT(1) = array(pt(0)-x*.5,pt(1)-c*.5,pt(2))
ptT(2) = array(pt(0)+x*.5,pt(1)-c*.5,pt(2))
ptT(3) = array(pt(0),pt(1)+y-c*.5,pt(2))
ptTetra(r) = ptT
r=r+1
'base type A
pt = array(ptT(1)(0),ptT(1)(1)+c*1.5+y,ptT(1)(2))
ptT(0) = array(pt(0),pt(1),pt(2))
ptT(1) = array(pt(0)+x*.5,pt(1)-c*.5,pt(2)-z)
ptT(2) = array(pt(0)-x*.5,pt(1)-c*.5,pt(2)-z)
ptT(3) = array(pt(0),pt(1)+y-c*.5,pt(2)-z)
ptB(r-1) = ptT
'base type B
ptT(0) = array(pt(0),pt(1),pt(2)-z*2)
ptB(r) = ptT
'type B
pt = array(ptA(0),ptA(1),ptA(2))
ptT(0) = array(pt(0),pt(1),pt(2)-z)
ptT(1) = array(pt(0)-x*.5,pt(1)+c*.5,pt(2))
ptT(2) = array(pt(0)+x*.5,pt(1)+c*.5,pt(2))
ptT(3) = array(pt(0),pt(1)-y+c*.5,pt(2))
ptTetra(r) = ptT
r=r+1
Next
ptSet(i) = ptTetra
ptSetB(i) = ptB
Next
'define colors and materials
Dim mtrl(5), lyrName, lyrClr, shnVal
If Rhino.IsLayer("overlay") = False Then
Call Rhino.AddLayer("overlay",RGB(0,0,0))
End If
shnVal = 1
lyrName = array("magenta","green","blue","yellow","white","black")
lyrClr = array(RGB(235,95,255),RGB(45,145,60),RGB(80,165,255),RGB(255,255,45),RGB(255,255,255),RGB(0,0,0))
For i = 0 To 5 Step 1
If Rhino.IsLayer(lyrName(i)) = False Then
Call Rhino.AddLayer(lyrName(i),lyrClr(i))
mtrl(i) = Rhino.AddMaterialToLayer(lyrName(i))
Call Rhino.MaterialColor(mtrl(i),lyrClr(i))
Call Rhino.MaterialShine (mtrl(i) ,shnVal)
Else
mtrl(i) = Rhino.LayerMaterialIndex (lyrName(i))
Call Rhino.MaterialShine (mtrl(i) ,shnVal)
End If
Next
ReDim clr(rows*2-1), clrSet(cols), triSet(2)
ReDim lyr(rows*2-1), lyrSet(cols), layers(2)
ReDim mat(rows*2-1), matSet(cols), materl(2)
Dim ba,bl,gr,ma,ye,wh
ba = 0: bl = 0: gr = 0: ma = 0: ye = 0: wh = 0
'determine color range
For i = 0 To cols-1 Step 1
For j = 1 To rows*2-2 Step 1
For k = 0 To 2 Step 1
If arrValue(k)(0)(i)(j)=arrValue(k)(1)(i)(j) And arrValue(k)(0)(i)(j)=arrValue(k)(2)(i)(j) Then
If arrValue(k)(0)(i)(j) < .5 Then
triSet(k) = RGB(0,0,0)
layers(k) = "black"
materl(k) = mtrl(5)
ba = ba+1
End If
If arrValue(k)(0)(i)(j) >= .5 Then
triSet(k) = RGB(255,255,255)
layers(k) = "white"
materl(k) = mtrl(4)
wh = wh+1
End If
End If
'magenta
If arrValue(k)(0)(i)(j)>arrValue(k)(1)(i)(j) And arrValue(k)(0)(i)(j)>arrValue(k)(2)(i)(j) Then
triSet(k) = RGB(235,95,255)
layers(k) = "magenta"
materl(k) = mtrl(0)
ma = ma+1
End If
'green
If arrValue(k)(1)(i)(j)>arrValue(k)(0)(i)(j) And arrValue(k)(1)(i)(j)>arrValue(k)(2)(i)(j) Then
triSet(k) = RGB(45,145,60)
layers(k) = "green"
materl(k) = mtrl(1)
gr = gr+1
End If
'blue
If arrValue(k)(2)(i)(j)>arrValue(k)(0)(i)(j) And arrValue(k)(2)(i)(j)>arrValue(k)(1)(i)(j) Then
triSet(k) = RGB(80,165,255)
layers(k) = "blue"
materl(k) = mtrl(2)
bl = bl+1
End If
'yellow
If arrValue(k)(0)(i)(j)>.7 And arrValue(k)(1)(i)(j)>.7 And arrValue(k)(2)(i)(j)<.1 Then
triSet(k) = RGB(255,255,45)
layers(k) = "yellow"
materl(k) = mtrl(3)
ye = ye+1
End If
'white
If arrValue(k)(0)(i)(j)>.8 And arrValue(k)(1)(i)(j)>.8 And arrValue(k)(2)(i)(j)>.8 Then
triSet(k) = RGB(255,255,255)
layers(k) = "white"
materl(k) = mtrl(4)
wh = wh+1
End If
'black
If arrValue(k)(0)(i)(j)<.2 And arrValue(k)(1)(i)(j)<.2 And arrValue(k)(2)(i)(j)<.2 Then
triSet(k) = RGB(0,0,0)
layers(k) = "black"
materl(k) = mtrl(5)
ba = ba+1
End If
Next
clr(j) = triSet
lyr(j) = layers
mat(j) = materl
Next
clrSet(i) = clr
lyrSet(i) = lyr
matSet(i) = mat
Next
If blnCut = True Then
' create codified cut template
Dim cutSet, cutCnt, center, cen, ptCen(3)
cutSet = array(ma,gr,bl,ye,wh,ba)
m=0
For i = 0 To 5 Step 1
k=0
n=0
p=0
cutCnt = cutSet(i)
Call Rhino.AddText(lyrName(i),array(m*(width+3),-height-1,0),.25)
For j = 0 To cutCnt-1 Step 1
If j*.5*x- CDbl(width)*k > CDbl(width) Then
k=k+1
n=0
End If
If k*(y+c*1.5)*.5 - p*CDbl(height) > CDbl(height) Then
m=m+1
n=0
p=p+1
End If
center = array(x*.5*n+m*(width+3),(y+c*1.5)*.5*k-(p+1)*height,0)
'Call Rhino.AddText(j,center)
If j Mod(2) Then
cen = array(center(0),center(1)+c*.5,center(2))
ptCen(0) = array(cen(0)-x*.5,cen(1)+c*.5,cen(2))
ptCen(1) = array(cen(0)+x*.5,cen(1)+c*.5,cen(2))
ptCen(2) = array(cen(0),cen(1)-y+c*.5,cen(2))
ptCen(3) = ptCen(0)
Else
cen = array(center(0),center(1),center(2))
ptCen(0) = array(cen(0)-x*.5,cen(1)-c*.5,cen(2))
ptCen(1) = array(cen(0)+x*.5,cen(1)-c*.5,cen(2))
ptCen(2) = array(cen(0),cen(1)+y-c*.5,cen(2))
ptCen(3) = ptCen(0)
End If
Call Rhino.ObjectColor(Rhino.AddPolyline(ptCen),lyrClr(i))
n=n+1
Next
m=m+1
Next
End If
'create and color surfaces tetrahedron points
Dim count, offset, cpy
ReDim srfs(rows*2-2),srfSet(cols-1), srf(3)
ReDim dwgsA(rows*2-2),dwgSetA(cols-1), dwgA(3)
ReDim dwgsB(rows*2-2),dwgSetB(cols-1), dwgB(3)
ReDim srfsB(rows*2-2),srfSetB(cols-1), srfB(3)
ReDim srfBln(rows*2-2),blnSet(cols-1)
For i = 0 To cols-1 Step 1
For j = 1 To rows*2-2 Step 1
offset = cols*.5*size+size*2
'create tetra surfaces and drawings
For k = 1 To 3 Step 1
If k<3 Then
srf(k) = Rhino.AddSrfPt(array(ptSet(i)(j)(0),ptSet(i)(j)(k),ptSet(i)(j)(k+1)))
dwgA(k) = Rhino.AddPolyline(array(array(ptSet(i)(j)(0)(0)+offset,ptSet(i)(j)(0)(1),0),array(ptSet(i)(j)(k)(0)+offset,ptSet(i)(j)(k)(1),0),array(ptSet(i)(j)(k+1)(0)+offset,ptSet(i)(j)(k+1)(1),0),array(ptSet(i)(j)(0)(0)+offset,ptSet(i)(j)(0)(1),0)))
If blnHatch = True Then
Call Rhino.ObjectLayer(Rhino.CopyObject(dwgA(k)),"overlay")
Call hatch(dwgA(k),lyrSet(i)(j)(k-1))
End If
Call Rhino.ObjectColor(array(srf(k),dwgA(k)),clrSet(i)(j)(k-1))
Call Rhino.ObjectLayer(array(srf(k),dwgA(k)),lyrSet(i)(j)(k-1))
Call Rhino.ObjectMaterialSource (srf(k) ,0)
Else
srf(k) = Rhino.AddSrfPt(array(ptSet(i)(j)(0),ptSet(i)(j)(k),ptSet(i)(j)(1)))
dwgA(k) = Rhino.AddPolyline(array(array(ptSet(i)(j)(0)(0)+offset,ptSet(i)(j)(0)(1),0),array(ptSet(i)(j)(k)(0)+offset,ptSet(i)(j)(k)(1),0),array(ptSet(i)(j)(1)(0)+offset,ptSet(i)(j)(1)(1),0),array(ptSet(i)(j)(0)(0)+offset,ptSet(i)(j)(0)(1),0)))
If blnHatch = True Then
Call Rhino.ObjectLayer(Rhino.CopyObject(dwgA(k)),"overlay")
Call hatch(dwgA(k),lyrSet(i)(j)(k-1))
End If
Call Rhino.ObjectColor(array(srf(k),dwgA(k)),clrSet(i)(j)(k-1))
Call Rhino.ObjectLayer(array(srf(k),dwgA(k)),lyrSet(i)(j)(k-1))
Call Rhino.ObjectMaterialSource (srf(k) ,0)
End If
Next
'create underside structure
offset = (cols*.5*size+size*2)*2
For k = 1 To 3 Step 1
If k<3 Then
srfB(k) = Rhino.AddSrfPt(array(ptSetB(i)(j-1)(0),ptSetB(i)(j-1)(k),ptSetB(i)(j-1)(k+1)))
dwgB(k) = Rhino.AddPolyline(array(array(ptSetB(i)(j-1)(0)(0)+offset,ptSetB(i)(j-1)(0)(1),0),array(ptSetB(i)(j-1)(k)(0)+offset,ptSetB(i)(j-1)(k)(1),0),array(ptSetB(i)(j-1)(k+1)(0)+offset,ptSetB(i)(j-1)(k+1)(1),0),array(ptSetB(i)(j-1)(0)(0)+offset,ptSetB(i)(j-1)(0)(1),0)))
If blnHatch = True Then
Call Rhino.ObjectLayer(Rhino.CopyObject(dwgB(k)),"overlay")
Call hatch(dwgB(k),lyrSet(i)(j)(k-1))
End If
Call Rhino.ObjectColor(array(srfB(k),dwgB(k)),clrSet(i)(j)(k-1))
Call Rhino.ObjectLayer(array(srfB(k),dwgB(k)),lyrSet(i)(j)(k-1))
Call Rhino.ObjectMaterialSource (srf(k) ,0)
Else
srfB(k) = Rhino.AddSrfPt(array(ptSetB(i)(j-1)(0),ptSetB(i)(j-1)(k),ptSetB(i)(j-1)(1)))
dwgB(k) = Rhino.AddPolyline(array(array(ptSetB(i)(j-1)(0)(0)+offset,ptSetB(i)(j-1)(0)(1),0),array(ptSetB(i)(j-1)(k)(0)+offset,ptSetB(i)(j-1)(k)(1),0),array(ptSetB(i)(j-1)(1)(0)+offset,ptSetB(i)(j-1)(1)(1),0),array(ptSetB(i)(j-1)(0)(0)+offset,ptSetB(i)(j-1)(0)(1),0)))
Call Rhino.ObjectColor(array(srfB(k),dwgB(k)),clrSet(i)(j)(k-1))
Call Rhino.ObjectLayer(array(srfB(k),dwgB(k)),lyrSet(i)(j)(k-1))
Call Rhino.ObjectMaterialSource (srf(k) ,0)
End If
Next
Next
blnSet(i) = srfBln
Next
End Function
Function arrImageSample(cols, rows)
arrImageSample = Null
'Instantiate the RhPicture Object
Dim RhPicture : Set RhPicture = Rhino.GetPlugInObject("RhPicture")
If IsNull(RhPicture) Then Exit Function
'Load an arbitrary image
If Not RhPicture.LoadImage() Then
Call Rhino.Print("Image not loaded")
Exit Function
End If
'Get the width and height
Dim w : w = RhPicture.Width()
Dim h : h = RhPicture.Height()
If IsNull(w) Or IsNull(h) Then
Call Rhino.Print("No valid image data")
Exit Function
End If
Dim x, y, i,j
Dim r, g, b, a, hu, s, u
ReDim r(rows), g(rows), b(rows), a(rows), hu(rows), s(rows), u(rows)
Dim rValSet, gValSet, bValSet, aValSet, hValSet, sValSet, uValSet
ReDim rValSet(cols), gValSet(cols), bValSet(cols), aValSet(cols), hValSet(cols), sValSet(cols), uValSet(cols)
'Sample Image returning all values between zero and one
For i = 0 To cols Step 1
For j = 0 To rows Step 1
x = int(w/cols)*i
y = int(h/rows)*j
If x>w Then
x = w
End If
If y>h Then
y = h
End If
r(j) = RhPicture.Red(x,y)/255
g(j) = RhPicture.Green(x,y)/255
b(j) = RhPicture.Blue(x,y)/255
a(j) = RhPicture.Alpha(x,y)/255
hu(j) = RhPicture.Hue(x,y)/360
s(j) = RhPicture.Saturation(x,y)
u(j) = RhPicture.Luminance(x,y)
Next
rValSet(i) = r
gValSet(i) = g
bValSet(i) = b
aValSet(i) = a
hValSet(i) = hu
sValSet(i) = s
uValSet(i) = u
Next
Set RhPicture = Nothing
' image outputs (0)red(1)green(2)blue(3)alpha(4)hue(5)saturation(6)luminance
arrImageSample = array(rValSet,gValSet,bValSet,aValSet,hValSet,sValSet,uValSet)
End Function
Function arrayValue(cols,rows,value)
arrayValue = Null
Dim i,j
ReDim val(rows), arrVal(cols)
For i = 0 To cols Step 1
For j = 0 To rows Step 1
val(j) = value
Next
arrVal(i) = val
Next
arrayValue = arrVal
End Function
Function hatch(strObject,strLayer)
hatch = Null
Dim layer
layer = Rhino.CurrentLayer()
Call Rhino.CurrentLayer(strLayer)
Call Rhino.SelectObject(strObject)
Call Rhino.Command("-Hatch P S _Enter")
Call Rhino.Command("SelNone")
Call Rhino.CurrentLayer(layer)
End Function
Option Explicit
'Script written by <insert name>
'Script copyrighted by <insert company name>
'Script version Thursday, May 15, 2008 9:24:31 AM
Call Main()
Sub Main()
Dim arrItems, arrValues, arrResults,blnResult,arrClr(2)
arrItems = array("Columns","Rows","Size","Width","Height")
arrValues= array(10,10,2,32,18)
arrResults = Rhino.PropertyListBox (arrItems, arrValues ,,"Sample Settings")
blnResult = Rhino.GetBoolean("ColorCells",array("fillType","outline","hatch","cutTemplate","No","Yes"),array(False,False))
If isNull(blnResult) Then Exit Sub
Dim i
For i = 0 To 2 Step 1
arrClr(i) = arrImageSample(arrResults(0)*4, arrResults(1)*2)
If isNull(arrClr(i)) Then Exit Sub
Next
Call Rhino.EnableRedraw(False)
Call TetraGrid(arrResults(0),arrResults(1),arrResults(3),arrResults(4),arrResults(2),array(array(arrClr(0)(0),arrClr(0)(1),arrClr(0)(2)),array(arrClr(1)(0),arrClr(1)(1),arrClr(1)(2)),array(arrClr(2)(0),arrClr(2)(1),arrClr(2)(2))),blnResult(0),blnResult(1))
Call Rhino.EnableRedraw(True)
End Sub
Function TetraGrid(cols,rows,width,height,size,arrValue,blnHatch,blnCut)
cols=cols*4
TetraGrid = Null
Dim i,j,k,m,n,p,r,s
Dim x,y,z,c, za
Dim pt, ptA
'calculate tetrahedron construction ratio's
x = size
y = size*cos(PI/6)
c= size*.5/sin(PI/3)
z = sqr(x^2-c^2)
'create packed tetrahedron points
ReDim ptT(3),ptTetra(rows*2), ptSet(cols)
ReDim ptB(rows*2),ptSetB(cols)
For i = 0 To cols-1 Step 1
r=0
For j = 0 To rows-1 Step 1
If i Mod(2) Then
ptA = array(x*.5*i,(y+c*1.5)*j+c*1.5,0)
Else
ptA = array(x*.5*i,(y+c*1.5)*j,0)
End If
'type A
pt = array(ptA(0),ptA(1)-c*2,ptA(2))
ptT(0) = array(pt(0),pt(1),pt(2)-z)
ptT(1) = array(pt(0)-x*.5,pt(1)-c*.5,pt(2))
ptT(2) = array(pt(0)+x*.5,pt(1)-c*.5,pt(2))
ptT(3) = array(pt(0),pt(1)+y-c*.5,pt(2))
ptTetra(r) = ptT
r=r+1
'base type A
pt = array(ptT(1)(0),ptT(1)(1)+c*1.5+y,ptT(1)(2))
ptT(0) = array(pt(0),pt(1),pt(2))
ptT(1) = array(pt(0)+x*.5,pt(1)-c*.5,pt(2)-z)
ptT(2) = array(pt(0)-x*.5,pt(1)-c*.5,pt(2)-z)
ptT(3) = array(pt(0),pt(1)+y-c*.5,pt(2)-z)
ptB(r-1) = ptT
'base type B
ptT(0) = array(pt(0),pt(1),pt(2)-z*2)
ptB(r) = ptT
'type B
pt = array(ptA(0),ptA(1),ptA(2))
ptT(0) = array(pt(0),pt(1),pt(2)-z)
ptT(1) = array(pt(0)-x*.5,pt(1)+c*.5,pt(2))
ptT(2) = array(pt(0)+x*.5,pt(1)+c*.5,pt(2))
ptT(3) = array(pt(0),pt(1)-y+c*.5,pt(2))
ptTetra(r) = ptT
r=r+1
Next
ptSet(i) = ptTetra
ptSetB(i) = ptB
Next
'define colors and materials
Dim mtrl(5), lyrName, lyrClr, shnVal
If Rhino.IsLayer("overlay") = False Then
Call Rhino.AddLayer("overlay",RGB(0,0,0))
End If
shnVal = 1
lyrName = array("magenta","green","blue","yellow","white","black")
lyrClr = array(RGB(235,95,255),RGB(45,145,60),RGB(80,165,255),RGB(255,255,45),RGB(255,255,255),RGB(0,0,0))
For i = 0 To 5 Step 1
If Rhino.IsLayer(lyrName(i)) = False Then
Call Rhino.AddLayer(lyrName(i),lyrClr(i))
mtrl(i) = Rhino.AddMaterialToLayer(lyrName(i))
Call Rhino.MaterialColor(mtrl(i),lyrClr(i))
Call Rhino.MaterialShine (mtrl(i) ,shnVal)
Else
mtrl(i) = Rhino.LayerMaterialIndex (lyrName(i))
Call Rhino.MaterialShine (mtrl(i) ,shnVal)
End If
Next
ReDim clr(rows*2-1), clrSet(cols), triSet(2)
ReDim lyr(rows*2-1), lyrSet(cols), layers(2)
ReDim mat(rows*2-1), matSet(cols), materl(2)
Dim ba,bl,gr,ma,ye,wh
ba = 0: bl = 0: gr = 0: ma = 0: ye = 0: wh = 0
'determine color range
For i = 0 To cols-1 Step 1
For j = 1 To rows*2-2 Step 1
For k = 0 To 2 Step 1
If arrValue(k)(0)(i)(j)=arrValue(k)(1)(i)(j) And arrValue(k)(0)(i)(j)=arrValue(k)(2)(i)(j) Then
If arrValue(k)(0)(i)(j) < .5 Then
triSet(k) = RGB(0,0,0)
layers(k) = "black"
materl(k) = mtrl(5)
ba = ba+1
End If
If arrValue(k)(0)(i)(j) >= .5 Then
triSet(k) = RGB(255,255,255)
layers(k) = "white"
materl(k) = mtrl(4)
wh = wh+1
End If
End If
'magenta
If arrValue(k)(0)(i)(j)>arrValue(k)(1)(i)(j) And arrValue(k)(0)(i)(j)>arrValue(k)(2)(i)(j) Then
triSet(k) = RGB(235,95,255)
layers(k) = "magenta"
materl(k) = mtrl(0)
ma = ma+1
End If
'green
If arrValue(k)(1)(i)(j)>arrValue(k)(0)(i)(j) And arrValue(k)(1)(i)(j)>arrValue(k)(2)(i)(j) Then
triSet(k) = RGB(45,145,60)
layers(k) = "green"
materl(k) = mtrl(1)
gr = gr+1
End If
'blue
If arrValue(k)(2)(i)(j)>arrValue(k)(0)(i)(j) And arrValue(k)(2)(i)(j)>arrValue(k)(1)(i)(j) Then
triSet(k) = RGB(80,165,255)
layers(k) = "blue"
materl(k) = mtrl(2)
bl = bl+1
End If
'yellow
If arrValue(k)(0)(i)(j)>.7 And arrValue(k)(1)(i)(j)>.7 And arrValue(k)(2)(i)(j)<.1 Then
triSet(k) = RGB(255,255,45)
layers(k) = "yellow"
materl(k) = mtrl(3)
ye = ye+1
End If
'white
If arrValue(k)(0)(i)(j)>.8 And arrValue(k)(1)(i)(j)>.8 And arrValue(k)(2)(i)(j)>.8 Then
triSet(k) = RGB(255,255,255)
layers(k) = "white"
materl(k) = mtrl(4)
wh = wh+1
End If
'black
If arrValue(k)(0)(i)(j)<.2 And arrValue(k)(1)(i)(j)<.2 And arrValue(k)(2)(i)(j)<.2 Then
triSet(k) = RGB(0,0,0)
layers(k) = "black"
materl(k) = mtrl(5)
ba = ba+1
End If
Next
clr(j) = triSet
lyr(j) = layers
mat(j) = materl
Next
clrSet(i) = clr
lyrSet(i) = lyr
matSet(i) = mat
Next
If blnCut = True Then
' create codified cut template
Dim cutSet, cutCnt, center, cen, ptCen(3)
cutSet = array(ma,gr,bl,ye,wh,ba)
m=0
For i = 0 To 5 Step 1
k=0
n=0
p=0
cutCnt = cutSet(i)
Call Rhino.AddText(lyrName(i),array(m*(width+3),-height-1,0),.25)
For j = 0 To cutCnt-1 Step 1
If j*.5*x- CDbl(width)*k > CDbl(width) Then
k=k+1
n=0
End If
If k*(y+c*1.5)*.5 - p*CDbl(height) > CDbl(height) Then
m=m+1
n=0
p=p+1
End If
center = array(x*.5*n+m*(width+3),(y+c*1.5)*.5*k-(p+1)*height,0)
'Call Rhino.AddText(j,center)
If j Mod(2) Then
cen = array(center(0),center(1)+c*.5,center(2))
ptCen(0) = array(cen(0)-x*.5,cen(1)+c*.5,cen(2))
ptCen(1) = array(cen(0)+x*.5,cen(1)+c*.5,cen(2))
ptCen(2) = array(cen(0),cen(1)-y+c*.5,cen(2))
ptCen(3) = ptCen(0)
Else
cen = array(center(0),center(1),center(2))
ptCen(0) = array(cen(0)-x*.5,cen(1)-c*.5,cen(2))
ptCen(1) = array(cen(0)+x*.5,cen(1)-c*.5,cen(2))
ptCen(2) = array(cen(0),cen(1)+y-c*.5,cen(2))
ptCen(3) = ptCen(0)
End If
Call Rhino.ObjectColor(Rhino.AddPolyline(ptCen),lyrClr(i))
n=n+1
Next
m=m+1
Next
End If
'create and color surfaces tetrahedron points
Dim count, offset, cpy
ReDim srfs(rows*2-2),srfSet(cols-1), srf(3)
ReDim dwgsA(rows*2-2),dwgSetA(cols-1), dwgA(3)
ReDim dwgsB(rows*2-2),dwgSetB(cols-1), dwgB(3)
ReDim srfsB(rows*2-2),srfSetB(cols-1), srfB(3)
ReDim srfBln(rows*2-2),blnSet(cols-1)
For i = 0 To cols-1 Step 1
For j = 1 To rows*2-2 Step 1
offset = cols*.5*size+size*2
'create tetra surfaces and drawings
For k = 1 To 3 Step 1
If k<3 Then
srf(k) = Rhino.AddSrfPt(array(ptSet(i)(j)(0),ptSet(i)(j)(k),ptSet(i)(j)(k+1)))
dwgA(k) = Rhino.AddPolyline(array(array(ptSet(i)(j)(0)(0)+offset,ptSet(i)(j)(0)(1),0),array(ptSet(i)(j)(k)(0)+offset,ptSet(i)(j)(k)(1),0),array(ptSet(i)(j)(k+1)(0)+offset,ptSet(i)(j)(k+1)(1),0),array(ptSet(i)(j)(0)(0)+offset,ptSet(i)(j)(0)(1),0)))
If blnHatch = True Then
Call Rhino.ObjectLayer(Rhino.CopyObject(dwgA(k)),"overlay")
Call hatch(dwgA(k),lyrSet(i)(j)(k-1))
End If
Call Rhino.ObjectColor(array(srf(k),dwgA(k)),clrSet(i)(j)(k-1))
Call Rhino.ObjectLayer(array(srf(k),dwgA(k)),lyrSet(i)(j)(k-1))
Call Rhino.ObjectMaterialSource (srf(k) ,0)
Else
srf(k) = Rhino.AddSrfPt(array(ptSet(i)(j)(0),ptSet(i)(j)(k),ptSet(i)(j)(1)))
dwgA(k) = Rhino.AddPolyline(array(array(ptSet(i)(j)(0)(0)+offset,ptSet(i)(j)(0)(1),0),array(ptSet(i)(j)(k)(0)+offset,ptSet(i)(j)(k)(1),0),array(ptSet(i)(j)(1)(0)+offset,ptSet(i)(j)(1)(1),0),array(ptSet(i)(j)(0)(0)+offset,ptSet(i)(j)(0)(1),0)))
If blnHatch = True Then
Call Rhino.ObjectLayer(Rhino.CopyObject(dwgA(k)),"overlay")
Call hatch(dwgA(k),lyrSet(i)(j)(k-1))
End If
Call Rhino.ObjectColor(array(srf(k),dwgA(k)),clrSet(i)(j)(k-1))
Call Rhino.ObjectLayer(array(srf(k),dwgA(k)),lyrSet(i)(j)(k-1))
Call Rhino.ObjectMaterialSource (srf(k) ,0)
End If
Next
'create underside structure
offset = (cols*.5*size+size*2)*2
For k = 1 To 3 Step 1
If k<3 Then
srfB(k) = Rhino.AddSrfPt(array(ptSetB(i)(j-1)(0),ptSetB(i)(j-1)(k),ptSetB(i)(j-1)(k+1)))
dwgB(k) = Rhino.AddPolyline(array(array(ptSetB(i)(j-1)(0)(0)+offset,ptSetB(i)(j-1)(0)(1),0),array(ptSetB(i)(j-1)(k)(0)+offset,ptSetB(i)(j-1)(k)(1),0),array(ptSetB(i)(j-1)(k+1)(0)+offset,ptSetB(i)(j-1)(k+1)(1),0),array(ptSetB(i)(j-1)(0)(0)+offset,ptSetB(i)(j-1)(0)(1),0)))
If blnHatch = True Then
Call Rhino.ObjectLayer(Rhino.CopyObject(dwgB(k)),"overlay")
Call hatch(dwgB(k),lyrSet(i)(j)(k-1))
End If
Call Rhino.ObjectColor(array(srfB(k),dwgB(k)),clrSet(i)(j)(k-1))
Call Rhino.ObjectLayer(array(srfB(k),dwgB(k)),lyrSet(i)(j)(k-1))
Call Rhino.ObjectMaterialSource (srf(k) ,0)
Else
srfB(k) = Rhino.AddSrfPt(array(ptSetB(i)(j-1)(0),ptSetB(i)(j-1)(k),ptSetB(i)(j-1)(1)))
dwgB(k) = Rhino.AddPolyline(array(array(ptSetB(i)(j-1)(0)(0)+offset,ptSetB(i)(j-1)(0)(1),0),array(ptSetB(i)(j-1)(k)(0)+offset,ptSetB(i)(j-1)(k)(1),0),array(ptSetB(i)(j-1)(1)(0)+offset,ptSetB(i)(j-1)(1)(1),0),array(ptSetB(i)(j-1)(0)(0)+offset,ptSetB(i)(j-1)(0)(1),0)))
Call Rhino.ObjectColor(array(srfB(k),dwgB(k)),clrSet(i)(j)(k-1))
Call Rhino.ObjectLayer(array(srfB(k),dwgB(k)),lyrSet(i)(j)(k-1))
Call Rhino.ObjectMaterialSource (srf(k) ,0)
End If
Next
Next
blnSet(i) = srfBln
Next
End Function
Function arrImageSample(cols, rows)
arrImageSample = Null
'Instantiate the RhPicture Object
Dim RhPicture : Set RhPicture = Rhino.GetPlugInObject("RhPicture")
If IsNull(RhPicture) Then Exit Function
'Load an arbitrary image
If Not RhPicture.LoadImage() Then
Call Rhino.Print("Image not loaded")
Exit Function
End If
'Get the width and height
Dim w : w = RhPicture.Width()
Dim h : h = RhPicture.Height()
If IsNull(w) Or IsNull(h) Then
Call Rhino.Print("No valid image data")
Exit Function
End If
Dim x, y, i,j
Dim r, g, b, a, hu, s, u
ReDim r(rows), g(rows), b(rows), a(rows), hu(rows), s(rows), u(rows)
Dim rValSet, gValSet, bValSet, aValSet, hValSet, sValSet, uValSet
ReDim rValSet(cols), gValSet(cols), bValSet(cols), aValSet(cols), hValSet(cols), sValSet(cols), uValSet(cols)
'Sample Image returning all values between zero and one
For i = 0 To cols Step 1
For j = 0 To rows Step 1
x = int(w/cols)*i
y = int(h/rows)*j
If x>w Then
x = w
End If
If y>h Then
y = h
End If
r(j) = RhPicture.Red(x,y)/255
g(j) = RhPicture.Green(x,y)/255
b(j) = RhPicture.Blue(x,y)/255
a(j) = RhPicture.Alpha(x,y)/255
hu(j) = RhPicture.Hue(x,y)/360
s(j) = RhPicture.Saturation(x,y)
u(j) = RhPicture.Luminance(x,y)
Next
rValSet(i) = r
gValSet(i) = g
bValSet(i) = b
aValSet(i) = a
hValSet(i) = hu
sValSet(i) = s
uValSet(i) = u
Next
Set RhPicture = Nothing
' image outputs (0)red(1)green(2)blue(3)alpha(4)hue(5)saturation(6)luminance
arrImageSample = array(rValSet,gValSet,bValSet,aValSet,hValSet,sValSet,uValSet)
End Function
Function arrayValue(cols,rows,value)
arrayValue = Null
Dim i,j
ReDim val(rows), arrVal(cols)
For i = 0 To cols Step 1
For j = 0 To rows Step 1
val(j) = value
Next
arrVal(i) = val
Next
arrayValue = arrVal
End Function
Function hatch(strObject,strLayer)
hatch = Null
Dim layer
layer = Rhino.CurrentLayer()
Call Rhino.CurrentLayer(strLayer)
Call Rhino.SelectObject(strObject)
Call Rhino.Command("-Hatch P S _Enter")
Call Rhino.Command("SelNone")
Call Rhino.CurrentLayer(layer)
End Function