TETRAliefs is individually customizable bi level table surface. With the New York apartment in mind it is designed to be repositioned as a lightweight wall-scape when not in functional use. With any readily available image production software the user can create the simple gray scale pattern which programs the table to meet their particular wants. The result of this image is a three dimensional reference model of the final piece, as well at layer by layer assembly map of the modules construction and a cutting template for fabrication. The cut template and components are designed to reduce fabrication waste through maximization of used material surface area.
| platform: Rhino Script |
| function: Wallscape |
Option Explicit
'Script written by <David Mans>
'Script copyrighted by <NeoArchaic.net>
'Script version Thursday, May 15, 2008 9:24:31 AM
Call Main()
Sub Main()
Dim arrClr
Dim arrItems, arrValues, arrResults,blnResult
arrItems = array("Columns","Rows","Size","Width","Height")
arrValues= array(10,10,2,32,18)
arrResults = Rhino.PropertyListBox (arrItems, arrValues ,,"Sample Settings")
If isNull(arrResults(0)) Then Exit Sub
arrClr = arrImageSample(arrResults(0)*4, arrResults(1)*2)
If isNull(arrClr) Then Exit Sub
Call Rhino.EnableRedraw(False)
Call TetraGrid(CDbl(arrResults(0)),CDbl(arrResults(1)),CDbl(arrResults(3)),CDbl(arrResults(4)),CDbl(arrResults(2)),arrClr(6))
Call Rhino.EnableRedraw(True)
End Sub
Function TetraGrid(cols,rows,width,height,size,arrValue)
cols=cols*4
TetraGrid = Null
Dim i,j,k,r,s,t
Dim x,y,z,c, za
Dim pt, ptA, clrtype
'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)
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
If arrValue(i)(r)< .4 Then
za = -z
Else
za = z
End If
pt = array(ptA(0),ptA(1)-c*2,ptA(2))
ptT(0) = array(pt(0),pt(1),pt(2)+za)
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
'type B
If arrValue(i)(r)< .4 Then
za = -z
Else
za = -z
End If
pt = array(ptA(0),ptA(1),ptA(2))
ptT(0) = array(pt(0),pt(1),pt(2)+za)
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
Next
Dim shnVal,lyrName,lyrClr,mtrl(2)
'create color layers and material colors
shnVal = 1
lyrName = array("black","grey","white")
lyrClr = array(RGB(1,1,1),RGB(175,175,175),RGB(255,255,255))
For i = 0 To 2 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
'create and color surfaces tetrahedron points
Dim clr, count, upDn
Dim dwgA(),dwgB(),dwgC()
ReDim srfs(rows*2-2),srfSet(cols-1), srf(3)
ReDim srfBln(rows*2-2),blnSet(cols-1)
ReDim srfBlnA(rows*2-2),blnSetA(cols-1)
r=0:s=0:t=0
For i = 0 To cols-1 Step 1
For j = 1 To rows*2-2 Step 1
'adjust for surface normal
If arrValue(i)(j)< .4 Then
clr = RGB(1,1,1)
clrtype = 0
upDn = 0
ElseIf arrValue(i)(j) >= .4 And arrValue(i)(j)< .8 Then
clr = RGB(175,175,175)
clrtype = 1
upDn = 1
Else
clr = RGB(255,255,255)
clrtype = 2
upDn = 1
End If
If j Mod(2) Then
ReDim Preserve dwgA(r)
srf(0) = Rhino.AddSrfPt(array(ptSet(i)(j)(1),ptSet(i)(j)(3),ptSet(i)(j)(2)))
dwgA(r)= array(array(ptSet(i)(j)(1),ptSet(i)(j)(3),ptSet(i)(j)(2)),clr,clrtype)
r=r+1
srfBln(j) = False
Else
ReDim Preserve dwgA(r)
srf(0) = Rhino.AddSrfPt(array(ptSet(i)(j)(1),ptSet(i)(j)(2),ptSet(i)(j)(3)))
dwgA(r)= array(array(ptSet(i)(j)(1),ptSet(i)(j)(3),ptSet(i)(j)(2)),clr,clrtype)
If arrValue(i)(j) >= .8 Then
srfBln(j) = True
Else
srfBln(j) = False
End If
If arrValue(i)(j) < .4 Then
srfBlnA(j) = True
Else
srfBlnA(j) = False
End If
End If
Call Rhino.ObjectColor(srf(0),clr)
Call Rhino.ObjectLayer(srf(0),lyrName(clrtype))
If j Mod(2) And arrValue(i)(j)> .4 Then
Else
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)))
If upDn= 1 Then
ReDim Preserve dwgB(s)
dwgB(s)= array(array(ptSet(i)(j)(0),ptSet(i)(j)(k),ptSet(i)(j)(k+1)),clr,clrtype)
s=s+1
Else
ReDim Preserve dwgC(t)
dwgC(t)= array(array(ptSet(i)(j)(0),ptSet(i)(j)(k),ptSet(i)(j)(k+1)),clr,clrtype)
t=t+1
End If
Else
srf(k) = Rhino.AddSrfPt(array(ptSet(i)(j)(0),ptSet(i)(j)(k),ptSet(i)(j)(1)))
If upDn= 1 Then
ReDim Preserve dwgB(s)
dwgB(s)= array(array(ptSet(i)(j)(0),ptSet(i)(j)(k),ptSet(i)(j)(1)),clr,clrtype)
s=s+1
Else
ReDim Preserve dwgC(t)
dwgC(t)= array(array(ptSet(i)(j)(0),ptSet(i)(j)(k),ptSet(i)(j)(1)),clr,clrtype)
t=t+1
End If
End If
Call Rhino.ObjectColor(srf(k),clr)
Call Rhino.ObjectLayer(srf(k),lyrName(clrtype))
Next
End If
Next
blnSet(i) = srfBln
blnSetA(i)= srfBlnA
Next
Dim dwgD(),dwgE(),dwgF()
Dim blnPair, tempSrf, tempPts
blnPair = array(blnSet,blnSetA)
r=0:s=0:t=0
For i = 0 To cols-1 Step 1
For j = 0 To rows*2-2 Step 1
'top plates band A
If ptSet(i)(j)(2)(2) < 0 Or ptSet(i)(j)(3)(2) < 0 Or ptSet(i)(j)(0)(2) < 0 Then
clr = RGB(1,1,1)
clrtype=0
upDN=1
Else
clr = RGB(255,255,255)
clrtype=2
upDN=0
End If
If i < cols-2 Then
If blnPair(0)(i)(j) = True And blnPair(0)(i+1)(j) = True And blnPair(0)(i+2)(j) = True Then
tempSrf = Rhino.AddSrfPt(array(ptSet(i+1)(j)(0),ptSet(i+2)(j)(0),ptSet(i)(j)(0)))
ReDim Preserve dwgD(r)
dwgD(r)= array(array(ptSet(i+1)(j)(0),ptSet(i+2)(j)(0),ptSet(i)(j)(0)),clr,clrtype)
r=r+1
Call Rhino.ObjectColor(tempSrf,clr)
Call Rhino.ObjectLayer(tempSrf,lyrName(clrtype))
End If
End If
'top plates band B
If i > 0 And i < cols-2 And j < rows*2-3 Then
If i Mod(2) Then
If blnPair(0)(i)(j) = True And blnPair(0)(i+1)(j+2) = True And blnPair(0)(i-1)(j+2) = True Then
tempSrf = Rhino.AddSrfPt(array(ptSet(i)(j)(0),ptSet(i-1)(j+2)(0),ptSet(i+1)(j+2)(0)))
ReDim Preserve dwgD(r)
dwgD(r)= array(array(ptSet(i)(j)(0),ptSet(i-1)(j+2)(0),ptSet(i+1)(j+2)(0)),clr,clrtype)
r=r+1
End If
Else
If blnPair(0)(i)(j+2) = True And blnPair(0)(i+1)(j) = True And blnPair(0)(i-1)(j) = True Then
tempSrf = Rhino.AddSrfPt(array(ptSet(i)(j+2)(0),ptSet(i-1)(j)(0),ptSet(i+1)(j)(0)))
ReDim Preserve dwgD(r)
dwgD(r)= array(array(ptSet(i)(j+2)(0),ptSet(i-1)(j)(0),ptSet(i+1)(j)(0)),clr,clrtype)
r=r+1
End If
End If
Call Rhino.ObjectColor(tempSrf,clr)
Call Rhino.ObjectLayer(tempSrf,lyrName(clrtype))
End If
For k = 0 To 1 Step 1
'front faces all
If i < cols-2 Then
If blnPair(k)(i)(j) = True And blnPair(k)(i+2)(j) = True Then
tempSrf = Rhino.AddSrfPt(array(ptSet(i)(j)(0),ptSet(i+2)(j)(0),ptSet(i)(j)(2)))
Call Rhino.ObjectColor(tempSrf,clr)
Call Rhino.ObjectLayer(tempSrf,lyrName(clrtype))
If upDn= 1 Then
ReDim Preserve dwgE(s)
dwgE(s)= array(array(ptSet(i)(j)(0),ptSet(i+2)(j)(0),ptSet(i)(j)(2)),clr,clrtype)
s=s+1
Else
ReDim Preserve dwgF(t)
dwgF(t)= array(array(ptSet(i)(j)(0),ptSet(i+2)(j)(0),ptSet(i)(j)(2)),clr,clrtype)
t=t+1
End If
End If
End If
'side faces band A
If i < cols-2 Then
If blnPair(k)(i)(j) = True And blnPair(k)(i+1)(j) = True Then
If i Mod(2) Then
tempSrf = Rhino.AddSrfPt(array(ptSet(i)(j)(0),ptSet(i+1)(j)(0),ptSet(i)(j)(2)))
tempPTs = array(ptSet(i)(j)(0),ptSet(i+1)(j)(0),ptSet(i)(j)(2))
Else
tempSrf = Rhino.AddSrfPt(array(ptSet(i)(j)(0),ptSet(i+1)(j)(0),ptSet(i)(j)(3)))
tempPTs = array(ptSet(i)(j)(0),ptSet(i+1)(j)(0),ptSet(i)(j)(3))
End If
Call Rhino.ObjectColor(tempSrf,clr)
Call Rhino.ObjectLayer(tempSrf,lyrName(clrtype))
If upDn= 1 Then
ReDim Preserve dwgE(s)
dwgE(s)= array(tempPTs,clr,clrtype)
s=s+1
Else
ReDim Preserve dwgF(t)
dwgF(t)= array(tempPTs,clr,clrtype)
t=t+1
End If
End If
End If
'side faces band B
If i Mod(2) Then
If i < cols-2 And j < rows*2-3 Then
If blnPair(k)(i)(j) = True And blnPair(k)(i+1)(j+2) = True Then
tempSrf = Rhino.AddSrfPt(array(ptSet(i)(j)(0),ptSet(i+1)(j+2)(0),ptSet(i)(j)(3)))
Call Rhino.ObjectColor(tempSrf,clr)
Call Rhino.ObjectLayer(tempSrf,lyrName(clrtype))
If upDn= 1 Then
ReDim Preserve dwgE(s)
dwgE(s)= array(array(ptSet(i)(j)(0),ptSet(i+1)(j+2)(0),ptSet(i)(j)(3)),clr,clrtype)
s=s+1
Else
ReDim Preserve dwgF(t)
dwgF(t)= array(array(ptSet(i)(j)(0),ptSet(i+1)(j+2)(0),ptSet(i)(j)(3)),clr,clrtype)
t=t+1
End If
End If
End If
Else
If i < cols-2 And j > 1 Then
If blnPair(k)(i)(j) = True And blnPair(k)(i+1)(j-2) = True Then
tempSrf = Rhino.AddSrfPt(array(ptSet(i)(j)(0),ptSet(i+1)(j-2)(0),ptSet(i)(j)(2)))
Call Rhino.ObjectColor(tempSrf,clr)
Call Rhino.ObjectLayer(tempSrf,lyrName(clrtype))
If upDn= 1 Then
ReDim Preserve dwgE(s)
dwgE(s)= array(array(ptSet(i)(j)(0),ptSet(i+1)(j-2)(0),ptSet(i)(j)(2)),clr,clrtype)
s=s+1
Else
ReDim Preserve dwgF(t)
dwgF(t)= array(array(ptSet(i)(j)(0),ptSet(i+1)(j-2)(0),ptSet(i)(j)(2)),clr,clrtype)
t=t+1
End If
End If
End If
End If
Next
Next
Next
clr = array(RGB(1,1,1),RGB(175,175,175),RGB(255,255,255))
Dim pst,pline,off,clrCnt(2)
clrCnt(0) = 0:clrCnt(1) = 0:clrCnt(2) = 0
pst = array(dwgA,dwgB,dwgC,dwgD,dwgE,dwgF)
For i = 0 To uBound(pst) Step 1
For j = 0 To uBound(pst(i)) Step 1
off = (i+1)*(cols*size*.5+size)
pline = Rhino.AddPolyline(array(array(pst(i)(j)(0)(0)(0)+off,pst(i)(j)(0)(0)(1),0),array(pst(i)(j)(0)(1)(0)+off,pst(i)(j)(0)(1)(1),0),array(pst(i)(j)(0)(2)(0)+off,pst(i)(j)(0)(2)(1),0),array(pst(i)(j)(0)(0)(0)+off,pst(i)(j)(0)(0)(1),0)))
Call Rhino.ObjectColor(pline,pst(i)(j)(1))
If pst(i)(j)(2) = 0 Then
clrCnt(0) = clrCnt(0)+1
ElseIf pst(i)(j)(2) = 1 Then
clrCnt(1) = clrCnt(1)+1
ElseIf pst(i)(j)(2) = 2 Then
clrCnt(2) = clrCnt(2)+1
End If
Next
Next
Dim cutPt(3)
t=0
For i = 0 To 2 Step 1
r=0
s=0
For j = 0 To clrCnt(i) Step 1
If s*size*.5 > width Then
r=r+1
s=0
End If
If r*size > height Then
r=0
t=t+width+size*2
End If
If r Mod(2) Then
ptA = array(x*.5*s+t,(y)*r-rows*size*2,0)
Else
ptA = array(x*.5*s+t,(y)*r-rows*size*2,0)
End If
If s Mod(2) Then
pt = array(ptA(0),ptA(1),ptA(2))
cutPt(0) = array(pt(0)-x*.5,pt(1)+c*.5,pt(2))
cutPt(1) = array(pt(0)+x*.5,pt(1)+c*.5,pt(2))
cutPt(2) = array(pt(0),pt(1)-y+c*.5,pt(2))
cutPt(3) = cutPt(0)
Call Rhino.ObjectColor(Rhino.AddPolyline(cutPt),clr(i))
Else
pt = array(ptA(0),ptA(1)-c*.5,ptA(2))
cutPt(0) = array(pt(0)-x*.5,pt(1)-c*.5,pt(2))
cutPt(1) = array(pt(0)+x*.5,pt(1)-c*.5,pt(2))
cutPt(2) = array(pt(0),pt(1)+y-c*.5,pt(2))
cutPt(3) = cutPt(0)
Call Rhino.ObjectColor(Rhino.AddPolyline(cutPt),clr(i))
End If
s=s+1
Next
t=t+width+size*2
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 <David Mans>
'Script copyrighted by <NeoArchaic.net>
'Script version Thursday, May 15, 2008 9:24:31 AM
Call Main()
Sub Main()
Dim arrClr
Dim arrItems, arrValues, arrResults,blnResult
arrItems = array("Columns","Rows","Size","Width","Height")
arrValues= array(10,10,2,32,18)
arrResults = Rhino.PropertyListBox (arrItems, arrValues ,,"Sample Settings")
If isNull(arrResults(0)) Then Exit Sub
arrClr = arrImageSample(arrResults(0)*4, arrResults(1)*2)
If isNull(arrClr) Then Exit Sub
Call Rhino.EnableRedraw(False)
Call TetraGrid(CDbl(arrResults(0)),CDbl(arrResults(1)),CDbl(arrResults(3)),CDbl(arrResults(4)),CDbl(arrResults(2)),arrClr(6))
Call Rhino.EnableRedraw(True)
End Sub
Function TetraGrid(cols,rows,width,height,size,arrValue)
cols=cols*4
TetraGrid = Null
Dim i,j,k,r,s,t
Dim x,y,z,c, za
Dim pt, ptA, clrtype
'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)
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
If arrValue(i)(r)< .4 Then
za = -z
Else
za = z
End If
pt = array(ptA(0),ptA(1)-c*2,ptA(2))
ptT(0) = array(pt(0),pt(1),pt(2)+za)
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
'type B
If arrValue(i)(r)< .4 Then
za = -z
Else
za = -z
End If
pt = array(ptA(0),ptA(1),ptA(2))
ptT(0) = array(pt(0),pt(1),pt(2)+za)
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
Next
Dim shnVal,lyrName,lyrClr,mtrl(2)
'create color layers and material colors
shnVal = 1
lyrName = array("black","grey","white")
lyrClr = array(RGB(1,1,1),RGB(175,175,175),RGB(255,255,255))
For i = 0 To 2 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
'create and color surfaces tetrahedron points
Dim clr, count, upDn
Dim dwgA(),dwgB(),dwgC()
ReDim srfs(rows*2-2),srfSet(cols-1), srf(3)
ReDim srfBln(rows*2-2),blnSet(cols-1)
ReDim srfBlnA(rows*2-2),blnSetA(cols-1)
r=0:s=0:t=0
For i = 0 To cols-1 Step 1
For j = 1 To rows*2-2 Step 1
'adjust for surface normal
If arrValue(i)(j)< .4 Then
clr = RGB(1,1,1)
clrtype = 0
upDn = 0
ElseIf arrValue(i)(j) >= .4 And arrValue(i)(j)< .8 Then
clr = RGB(175,175,175)
clrtype = 1
upDn = 1
Else
clr = RGB(255,255,255)
clrtype = 2
upDn = 1
End If
If j Mod(2) Then
ReDim Preserve dwgA(r)
srf(0) = Rhino.AddSrfPt(array(ptSet(i)(j)(1),ptSet(i)(j)(3),ptSet(i)(j)(2)))
dwgA(r)= array(array(ptSet(i)(j)(1),ptSet(i)(j)(3),ptSet(i)(j)(2)),clr,clrtype)
r=r+1
srfBln(j) = False
Else
ReDim Preserve dwgA(r)
srf(0) = Rhino.AddSrfPt(array(ptSet(i)(j)(1),ptSet(i)(j)(2),ptSet(i)(j)(3)))
dwgA(r)= array(array(ptSet(i)(j)(1),ptSet(i)(j)(3),ptSet(i)(j)(2)),clr,clrtype)
If arrValue(i)(j) >= .8 Then
srfBln(j) = True
Else
srfBln(j) = False
End If
If arrValue(i)(j) < .4 Then
srfBlnA(j) = True
Else
srfBlnA(j) = False
End If
End If
Call Rhino.ObjectColor(srf(0),clr)
Call Rhino.ObjectLayer(srf(0),lyrName(clrtype))
If j Mod(2) And arrValue(i)(j)> .4 Then
Else
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)))
If upDn= 1 Then
ReDim Preserve dwgB(s)
dwgB(s)= array(array(ptSet(i)(j)(0),ptSet(i)(j)(k),ptSet(i)(j)(k+1)),clr,clrtype)
s=s+1
Else
ReDim Preserve dwgC(t)
dwgC(t)= array(array(ptSet(i)(j)(0),ptSet(i)(j)(k),ptSet(i)(j)(k+1)),clr,clrtype)
t=t+1
End If
Else
srf(k) = Rhino.AddSrfPt(array(ptSet(i)(j)(0),ptSet(i)(j)(k),ptSet(i)(j)(1)))
If upDn= 1 Then
ReDim Preserve dwgB(s)
dwgB(s)= array(array(ptSet(i)(j)(0),ptSet(i)(j)(k),ptSet(i)(j)(1)),clr,clrtype)
s=s+1
Else
ReDim Preserve dwgC(t)
dwgC(t)= array(array(ptSet(i)(j)(0),ptSet(i)(j)(k),ptSet(i)(j)(1)),clr,clrtype)
t=t+1
End If
End If
Call Rhino.ObjectColor(srf(k),clr)
Call Rhino.ObjectLayer(srf(k),lyrName(clrtype))
Next
End If
Next
blnSet(i) = srfBln
blnSetA(i)= srfBlnA
Next
Dim dwgD(),dwgE(),dwgF()
Dim blnPair, tempSrf, tempPts
blnPair = array(blnSet,blnSetA)
r=0:s=0:t=0
For i = 0 To cols-1 Step 1
For j = 0 To rows*2-2 Step 1
'top plates band A
If ptSet(i)(j)(2)(2) < 0 Or ptSet(i)(j)(3)(2) < 0 Or ptSet(i)(j)(0)(2) < 0 Then
clr = RGB(1,1,1)
clrtype=0
upDN=1
Else
clr = RGB(255,255,255)
clrtype=2
upDN=0
End If
If i < cols-2 Then
If blnPair(0)(i)(j) = True And blnPair(0)(i+1)(j) = True And blnPair(0)(i+2)(j) = True Then
tempSrf = Rhino.AddSrfPt(array(ptSet(i+1)(j)(0),ptSet(i+2)(j)(0),ptSet(i)(j)(0)))
ReDim Preserve dwgD(r)
dwgD(r)= array(array(ptSet(i+1)(j)(0),ptSet(i+2)(j)(0),ptSet(i)(j)(0)),clr,clrtype)
r=r+1
Call Rhino.ObjectColor(tempSrf,clr)
Call Rhino.ObjectLayer(tempSrf,lyrName(clrtype))
End If
End If
'top plates band B
If i > 0 And i < cols-2 And j < rows*2-3 Then
If i Mod(2) Then
If blnPair(0)(i)(j) = True And blnPair(0)(i+1)(j+2) = True And blnPair(0)(i-1)(j+2) = True Then
tempSrf = Rhino.AddSrfPt(array(ptSet(i)(j)(0),ptSet(i-1)(j+2)(0),ptSet(i+1)(j+2)(0)))
ReDim Preserve dwgD(r)
dwgD(r)= array(array(ptSet(i)(j)(0),ptSet(i-1)(j+2)(0),ptSet(i+1)(j+2)(0)),clr,clrtype)
r=r+1
End If
Else
If blnPair(0)(i)(j+2) = True And blnPair(0)(i+1)(j) = True And blnPair(0)(i-1)(j) = True Then
tempSrf = Rhino.AddSrfPt(array(ptSet(i)(j+2)(0),ptSet(i-1)(j)(0),ptSet(i+1)(j)(0)))
ReDim Preserve dwgD(r)
dwgD(r)= array(array(ptSet(i)(j+2)(0),ptSet(i-1)(j)(0),ptSet(i+1)(j)(0)),clr,clrtype)
r=r+1
End If
End If
Call Rhino.ObjectColor(tempSrf,clr)
Call Rhino.ObjectLayer(tempSrf,lyrName(clrtype))
End If
For k = 0 To 1 Step 1
'front faces all
If i < cols-2 Then
If blnPair(k)(i)(j) = True And blnPair(k)(i+2)(j) = True Then
tempSrf = Rhino.AddSrfPt(array(ptSet(i)(j)(0),ptSet(i+2)(j)(0),ptSet(i)(j)(2)))
Call Rhino.ObjectColor(tempSrf,clr)
Call Rhino.ObjectLayer(tempSrf,lyrName(clrtype))
If upDn= 1 Then
ReDim Preserve dwgE(s)
dwgE(s)= array(array(ptSet(i)(j)(0),ptSet(i+2)(j)(0),ptSet(i)(j)(2)),clr,clrtype)
s=s+1
Else
ReDim Preserve dwgF(t)
dwgF(t)= array(array(ptSet(i)(j)(0),ptSet(i+2)(j)(0),ptSet(i)(j)(2)),clr,clrtype)
t=t+1
End If
End If
End If
'side faces band A
If i < cols-2 Then
If blnPair(k)(i)(j) = True And blnPair(k)(i+1)(j) = True Then
If i Mod(2) Then
tempSrf = Rhino.AddSrfPt(array(ptSet(i)(j)(0),ptSet(i+1)(j)(0),ptSet(i)(j)(2)))
tempPTs = array(ptSet(i)(j)(0),ptSet(i+1)(j)(0),ptSet(i)(j)(2))
Else
tempSrf = Rhino.AddSrfPt(array(ptSet(i)(j)(0),ptSet(i+1)(j)(0),ptSet(i)(j)(3)))
tempPTs = array(ptSet(i)(j)(0),ptSet(i+1)(j)(0),ptSet(i)(j)(3))
End If
Call Rhino.ObjectColor(tempSrf,clr)
Call Rhino.ObjectLayer(tempSrf,lyrName(clrtype))
If upDn= 1 Then
ReDim Preserve dwgE(s)
dwgE(s)= array(tempPTs,clr,clrtype)
s=s+1
Else
ReDim Preserve dwgF(t)
dwgF(t)= array(tempPTs,clr,clrtype)
t=t+1
End If
End If
End If
'side faces band B
If i Mod(2) Then
If i < cols-2 And j < rows*2-3 Then
If blnPair(k)(i)(j) = True And blnPair(k)(i+1)(j+2) = True Then
tempSrf = Rhino.AddSrfPt(array(ptSet(i)(j)(0),ptSet(i+1)(j+2)(0),ptSet(i)(j)(3)))
Call Rhino.ObjectColor(tempSrf,clr)
Call Rhino.ObjectLayer(tempSrf,lyrName(clrtype))
If upDn= 1 Then
ReDim Preserve dwgE(s)
dwgE(s)= array(array(ptSet(i)(j)(0),ptSet(i+1)(j+2)(0),ptSet(i)(j)(3)),clr,clrtype)
s=s+1
Else
ReDim Preserve dwgF(t)
dwgF(t)= array(array(ptSet(i)(j)(0),ptSet(i+1)(j+2)(0),ptSet(i)(j)(3)),clr,clrtype)
t=t+1
End If
End If
End If
Else
If i < cols-2 And j > 1 Then
If blnPair(k)(i)(j) = True And blnPair(k)(i+1)(j-2) = True Then
tempSrf = Rhino.AddSrfPt(array(ptSet(i)(j)(0),ptSet(i+1)(j-2)(0),ptSet(i)(j)(2)))
Call Rhino.ObjectColor(tempSrf,clr)
Call Rhino.ObjectLayer(tempSrf,lyrName(clrtype))
If upDn= 1 Then
ReDim Preserve dwgE(s)
dwgE(s)= array(array(ptSet(i)(j)(0),ptSet(i+1)(j-2)(0),ptSet(i)(j)(2)),clr,clrtype)
s=s+1
Else
ReDim Preserve dwgF(t)
dwgF(t)= array(array(ptSet(i)(j)(0),ptSet(i+1)(j-2)(0),ptSet(i)(j)(2)),clr,clrtype)
t=t+1
End If
End If
End If
End If
Next
Next
Next
clr = array(RGB(1,1,1),RGB(175,175,175),RGB(255,255,255))
Dim pst,pline,off,clrCnt(2)
clrCnt(0) = 0:clrCnt(1) = 0:clrCnt(2) = 0
pst = array(dwgA,dwgB,dwgC,dwgD,dwgE,dwgF)
For i = 0 To uBound(pst) Step 1
For j = 0 To uBound(pst(i)) Step 1
off = (i+1)*(cols*size*.5+size)
pline = Rhino.AddPolyline(array(array(pst(i)(j)(0)(0)(0)+off,pst(i)(j)(0)(0)(1),0),array(pst(i)(j)(0)(1)(0)+off,pst(i)(j)(0)(1)(1),0),array(pst(i)(j)(0)(2)(0)+off,pst(i)(j)(0)(2)(1),0),array(pst(i)(j)(0)(0)(0)+off,pst(i)(j)(0)(0)(1),0)))
Call Rhino.ObjectColor(pline,pst(i)(j)(1))
If pst(i)(j)(2) = 0 Then
clrCnt(0) = clrCnt(0)+1
ElseIf pst(i)(j)(2) = 1 Then
clrCnt(1) = clrCnt(1)+1
ElseIf pst(i)(j)(2) = 2 Then
clrCnt(2) = clrCnt(2)+1
End If
Next
Next
Dim cutPt(3)
t=0
For i = 0 To 2 Step 1
r=0
s=0
For j = 0 To clrCnt(i) Step 1
If s*size*.5 > width Then
r=r+1
s=0
End If
If r*size > height Then
r=0
t=t+width+size*2
End If
If r Mod(2) Then
ptA = array(x*.5*s+t,(y)*r-rows*size*2,0)
Else
ptA = array(x*.5*s+t,(y)*r-rows*size*2,0)
End If
If s Mod(2) Then
pt = array(ptA(0),ptA(1),ptA(2))
cutPt(0) = array(pt(0)-x*.5,pt(1)+c*.5,pt(2))
cutPt(1) = array(pt(0)+x*.5,pt(1)+c*.5,pt(2))
cutPt(2) = array(pt(0),pt(1)-y+c*.5,pt(2))
cutPt(3) = cutPt(0)
Call Rhino.ObjectColor(Rhino.AddPolyline(cutPt),clr(i))
Else
pt = array(ptA(0),ptA(1)-c*.5,ptA(2))
cutPt(0) = array(pt(0)-x*.5,pt(1)-c*.5,pt(2))
cutPt(1) = array(pt(0)+x*.5,pt(1)-c*.5,pt(2))
cutPt(2) = array(pt(0),pt(1)+y-c*.5,pt(2))
cutPt(3) = cutPt(0)
Call Rhino.ObjectColor(Rhino.AddPolyline(cutPt),clr(i))
End If
s=s+1
Next
t=t+width+size*2
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