Hexagon Panelization

Panelization casestydy: Santa Caterina Market.

Each panel is flat, leaving slight gap to its neighbors. I started with hexagon-shape grid on surface as in the last image. Six points are identified and stored in array per one panel. Then to produce flat panels, I projected each vector to each normal plane (red). Vector projection is simple VectorAdd method except that I needed to flip the normals (blue) depending on the beginning angle between normals and direct vectors (white) on surface.

PowerCopy Automation

Fabric pattern completed via powerCopy Automation. Method is the following three steps →


STEP1. BeginInstanceFactory: to initialize the InstanceFactory with the reference and the document where it is stored. This step must be called once at the beginning whatever the number of instantiations are done.

STEP2. It is composed of five methods that must be called in the order. This set of five methods can be called in a loop in order to make several instantiations.

a. The method BeginInstantiate: to initialize all data of the reference.
b. The method PutInputData: to set a value to any input.
c. The method GetParameter: to retrieve published parameter.
d. The method Instantiate: to recreate the reference.
e. The method EndInstantiate: to indicate the instantiation is done.

STEP3. EndInstantiateFactory: to end instantiation and cleaning the InstanceFactory. When doing several instantiations in a loop, this step must be called just once at the end of all instantiations.

boundary cone

Option Explicit
'Author: YukiukiH
'Date: 10/08/2008
'compatibility: Rhino4
''boundary CONE
'----------------------------------------------------------------------------------------------
Dim strTrgPt, arrTrgPt
strTrgPt = Rhino.GetObject ("select a target point", 1)
Dim strALLRefPts
strALLRefPts = Rhino.GetObjects ("select reference points", 1)
Dim strPtDir, arrPtDir, arrDirVector
strPtDir = Rhino.GetObject ("select a point for direction", 1)
Dim strRefPts
strRefPts = boundaryCone (strTrgPt, strALLRefPts, strPtDir, 400, 30)

'color
Dim intR, intG, intB
Dim i
For i = 0 To UBound(strRefPts)
intR =255
intG =25+i*Rnd()*2
intB =0
Call Rhino.ObjectColor (strRefPts(i), RGB(intR, intG, intB))
Next
Call Rhino.print("execution completed")


'----------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------
Function boundaryCone (strTrgPt, strALLRefPts, strPtDir, dblBoundCos, dblBoundAngle)
Dim arrResult

'coordinate extraction
'----------------------------------------------------------------------------------------------
Dim arrTrgPt
arrTrgPt = Rhino.PointCoordinates (strTrgPt)
Dim arrALLRefPts()
Dim i
For i = 0 To UBound(strALLRefPts)
ReDim Preserve arrALLRefPts(i)
arrALLRefPts(i) = Rhino.PointCoordinates (strALLRefPts(i))
Next
Dim arrPtDir
arrPtDir = Rhino.PointCoordinates (strPtDir)

'set boundary
'---------------------------------------
Dim arrLine1(1), arrLine2(1)
Dim dblAngles, dblVectorLength, dblDist
Dim arrREFPts(), strRefPts()
Dim n, m
n = 0
For m = 0 To UBound(arrALLRefPts)
arrLine1(0) = arrPtDir
arrLine1(1) = arrTrgPt
arrLine2(0) = arrALLRefPts(m)
arrLine2(1) = arrTrgPt
dblAngles = Rhino.Angle2 (arrLine1, arrLine2)

If dblAngles(0) < dblBoundAngle Then
dblVectorLength = Rhino.Distance (arrALLRefPts(m), arrTrgPt)
dblDist = dblVectorLength *Cos(dblAngles(0)*2*dblPi/360) 'cone
If dblDist < dblBoundCos Then
Call Rhino.Print ("through point: " & CStr(n+1))
ReDim Preserve arrRefPts(n)
arrRefPts(n) = arrALLRefPts(m)
ReDim Preserve strRefPts(n)
strRefPts(n) = strALLRefPts(m)
n = n+1
End If
End If

Next
'---------------------------------------
arrResult = strRefPts
boundaryCone = arrResult
End Function
'----------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------

boundary partial sphere

Option Explicit
'Author: YukiukiH
'Date: 10/08/2008
'compatibility: Rhino4
''boundary PARTIAL SPHERE
'----------------------------------------------------------------------------------------------
Dim strTrgPt, arrTrgPt
strTrgPt = Rhino.GetObject ("select a target point", 1)
Dim strALLRefPts
strALLRefPts = Rhino.GetObjects ("select reference points", 1)
Dim strPtDir, arrPtDir, arrDirVector
strPtDir = Rhino.GetObject ("select a point for direction", 1)
Dim strRefPts
strRefPts = boundaryPartialSphere (strTrgPt, strALLRefPts, strPtDir, 450, 30)

'color
Dim intR, intG, intB
Dim i
For i = 0 To UBound(strRefPts)
intR =255
intG =25+i*Rnd()*2
intB =0
Call Rhino.ObjectColor (strRefPts(i), RGB(intR, intG, intB))
Next
Call Rhino.print("execution completed")


'----------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------
Function boundaryPartialSphere (strTrgPt, strALLRefPts, strPtDir, dblBoundR, dblBoundAngle)
Dim arrResult

'coordinate extraction
'---------------------------------------
Dim arrTrgPt
arrTrgPt = Rhino.PointCoordinates (strTrgPt)
Dim arrALLRefPts()
Dim i
For i = 0 To UBound(strALLRefPts)
ReDim Preserve arrALLRefPts(i)
arrALLRefPts(i) = Rhino.PointCoordinates (strALLRefPts(i))
Next
Dim arrPtDir
arrPtDir = Rhino.PointCoordinates (strPtDir)

'set boundary
'---------------------------------------
Dim dblDist, dblAngles, arrDir
Dim arrLine1(1), arrLine2(1)
Dim arrREFPts(), strRefPts()
Dim n, m
n = 0
For m = 0 To UBound(arrALLRefPts)
dblDist = Rhino.Distance (arrTrgPt, arrALLRefPts(m))

If dblDist < dblBoundR Then
arrLine1(0) = arrPtDir
arrLine1(1) = arrTrgPt
arrLine2(0) = arrALLRefPts(m)
arrLine2(1) = arrTrgPt
dblAngles = Rhino.Angle2 (arrLine1, arrLine2)
If dblAngles(0) < dblBoundAngle Then
Call Rhino.Print ("through point: " & CStr(n+1))
ReDim Preserve arrRefPts(n)
arrRefPts(n) = arrALLRefPts(m)
ReDim Preserve strRefPts(n)
strRefPts(n) = strALLRefPts(m)
n = n+1
End If
End If

Next
'---------------------------------------
arrResult = strRefPts
boundaryPartialSphere = arrResult
End Function
'----------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------

boundary sphere

Option Explicit
'Author: YukiukiH
'Date: 10/08/2008
'compatibility: Rhino4
''boundary SPHERE
'----------------------------------------------------------------------------------------------
Dim strTrgPt
strTrgPt = Rhino.GetObject ("select a target point", 1)
Dim strALLRefPts
strALLRefPts = Rhino.GetObjects ("select reference points", 1)
Dim strRefPts
strRefPts = boundarySphere (strTrgPt, strALLRefPts, 250)

'color
Dim intR, intG, intB
Dim i
For i = 0 To UBound(strRefPts)
intR =255
intG =25+i*Rnd()*2
intB =0
Call Rhino.ObjectColor (strRefPts(i), RGB(intR, intG, intB))
Next
Call Rhino.print("execution completed")


'----------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------
Function boundarySphere (strTrgPt, strALLRefPts, dblBoundR)
Dim arrResult


'coordinate extraction
'---------------------------------------
Dim arrTrgPt
arrTrgPt = Rhino.PointCoordinates (strTrgPt)
Dim arrALLRefPts()
Dim i
For i = 0 To UBound(strALLRefPts)
ReDim Preserve arrALLRefPts(i)
arrALLRefPts(i) = Rhino.PointCoordinates (strALLRefPts(i))
Next


'set boundary
'---------------------------------------
Dim dblDist, arrREFPts(), strRefPts()
Dim n, m
n = 0
For m = 0 To UBound(arrALLRefPts)
dblDist = Rhino.Distance (arrTrgPt, arrALLRefPts(m))

If dblDist < dblBoundR Then
Call Rhino.Print ("through point: " & CStr(n+1))
ReDim Preserve arrRefPts(n)
arrRefPts(n) = arrALLRefPts(m)
ReDim Preserve strRefPts(n)
strRefPts(n) = strALLRefPts(m)
n = n+1
End If

Next
'---------------------------------------
arrResult = strRefPts
boundarySphere = arrResult
End Function
'----------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------

boundary cylinder

Option Explicit
'Author: YukiukiH
'Date: 10/08/2008
'compatibility: Rhino4
''boundary CYLINDER
'----------------------------------------------------------------------------------------------
Dim strTrgPt
strTrgPt = Rhino.GetObject ("select a target point", 1)
Dim strALLRefPts
strALLRefPts = Rhino.GetObjects ("select reference points", 1)
Dim strRefPts
strRefPts = boundaryCylinder (strTrgPt, strALLRefPts, 200, 400)

'color
Dim intR, intG, intB
Dim i
For i = 0 To UBound(strRefPts)
intR =255
intG =25+i*Rnd()*2
intB =0
Call Rhino.ObjectColor (strRefPts(i), RGB(intR, intG, intB))
Next
Call Rhino.print("execution completed")


'----------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------
Function boundaryCylinder (strTrgPt, strALLRefPts, dblBoundR, dblBoundZ)
Dim arrResult

'coordinate extraction
'---------------------------------------
Dim arrTrgPt
arrTrgPt = Rhino.PointCoordinates (strTrgPt)
Dim arrALLRefPts()
Dim i
For i = 0 To UBound(strALLRefPts)
ReDim Preserve arrALLRefPts(i)
arrALLRefPts(i) = Rhino.PointCoordinates (strALLRefPts(i))
Next

'set boundary
'---------------------------------------
Dim arrFlatPt, arrFlatRefPt, dblDist, dblmaxZ, dblminZ
Dim arrREFPts(), strRefPts()
dblmaxZ = arrTrgPt(2) + dblBoundZ
dblminZ = arrTrgPt(2)

Dim n, m
n = 0
For m = 0 To UBound(arrALLRefPts)
arrFlatPt = Array(arrTrgPt(0), arrTrgPt(1), 0)
arrFlatRefPt = Array(arrALLRefPts(m)(0),arrALLRefPts(m)(1), 0)
dblDist = Rhino.Distance (arrFlatPt, arrFlatRefPt)
If dblDist < dblBoundR Then
If dblmaxZ>arrALLRefPts(m)(2) And arrALLRefPts(m)(2)>dblminZ Then

Call Rhino.Print ("through point: " & CStr(n+1))
ReDim Preserve arrRefPts(n)
arrRefPts(n) = arrALLRefPts(m)
ReDim Preserve strRefPts(n)
strRefPts(n) = strALLRefPts(m)
n = n+1

End If
End If
Next
'---------------------------------------
arrResult = strRefPts
boundaryCylinder = arrResult
End Function
'----------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------

bounday cube

Option Explicit
'Author: YukiukiH
'Date: 10/08/2008
'compatibility: Rhino4
''boundary CUBE
'----------------------------------------------------------------------------------------------
Dim strTrgPt
strTrgPt = Rhino.GetObject ("select a target point", 1)
Dim strALLRefPts
strALLRefPts = Rhino.GetObjects ("select reference points", 1)
Dim strRefPts
strRefPts = boundaryCube (strTrgPt, strALLRefPts, 300, 300, 400)

'color
Dim intR, intG, intB
Dim i
For i = 0 To UBound(strRefPts)
intR =255
intG =25+i*Rnd()*2
intB =0
Call Rhino.ObjectColor (strRefPts(i), RGB(intR, intG, intB))
Next
Call Rhino.print("execution completed")


'----------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------
Function boundaryCube (strTrgPt, strALLRefPts, dblBoundX, dblBoundY, dblBoundZ)
Dim arrResult

'coordinate extraction
'---------------------------------------
Dim arrTrgPt
arrTrgPt = Rhino.PointCoordinates (strTrgPt)
Dim arrALLRefPts()
Dim i
For i = 0 To UBound(strALLRefPts)
ReDim Preserve arrALLRefPts(i)
arrALLRefPts(i) = Rhino.PointCoordinates (strALLRefPts(i))
Next

'set boundary
'---------------------------------------
Dim dblmaxX, dblminX, dblmaxY, dblminY, dblmaxZ, dblminZ
Dim arrREFPts(), strRefPts()
dblmaxX = arrTrgPt(0) +(dblBoundX/2)
dblminX = arrTrgPt(0) -(dblBoundX/2)
dblmaxY = arrTrgPt(1) +(dblBoundY/2)
dblminY = arrTrgPt(1) -(dblBoundY/2)
dblmaxZ = arrTrgPt(2) +(dblBoundZ/2)
dblminZ = arrTrgPt(2) -(dblBoundZ/2)

Dim n, m
n = 0
For m = 0 To UBound(arrALLRefPts)
If dblmaxX>arrALLRefPts(m)(0) And arrALLRefPts(m)(0)>dblminX Then
If dblmaxY>arrALLRefPts(m)(1) And arrALLRefPts(m)(1)>dblminY Then
If dblmaxZ>arrALLRefPts(m)(2) And arrALLRefPts(m)(2)>dblminZ Then

Call Rhino.Print ("through point: " & CStr(n+1))
ReDim Preserve arrRefPts(n)
arrRefPts(n) = arrALLRefPts(m)
ReDim Preserve strRefPts(n)
strRefPts(n) = strALLRefPts(m)
n = n+1

End If
End If
End If
Next
'---------------------------------------
arrResult = strRefPts
boundaryCube = arrResult
End Function
'----------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------

makeTree Revision

Option Explicit
'Author: YukiukiH
'Date: 08/10/03
'compatibility: Rhino4
''branching using vector

'first things first...
'----------------------------------------------------------------------------------------------
Dim strRtPts
strRtPts = Rhino.GetObjects ("select root points", 1)
Call Rhino.AddLayer ("ptCloudRT", RGB(0,0,0)) 'black
Call Rhino.ObjectLayer (strRtPts, "ptCloudRT")
Dim strALLREFPts
strALLREFPts = Rhino.GetObjects ("select reference points", 1)
Call Rhino.AddLayer ("ptCloudREF", RGB(105,105,105)) 'gray
Call Rhino.ObjectLayer (strALLREFPts, "ptCloudREF")
Dim dblNumber
dblNumber = 7 '4
Dim dblBoundary
dblBoundary = 100 '100
Call Rhino.Print ("minimize rhino window")

'call function
Dim arrResultBranchs
arrResultBranchs = branch (strRtPts, strALLREFPts, dblNumber, dblBoundary)

Dim arrResultTrees, i, j
For j = 0 To UBound(arrResultBranchs)
'call function
ReDim Preserve arrResultTrees(j)
arrResultTrees(j) = tree (20, arrResultBranchs(j))
Dim arrResult01, arrResult02, dblS, dblT

If dblNumber Mod 2 = 1 Then
dblS = dblNumber/2+0.5
dblT = dblNumber-dblS
Else
dblS = dblNumber/2
dblT = dblNumber/2
End If

ReDim arrResult01(dblS-1)
ReDim arrResult02(dblT-1)
Rhino.print("dblS = " & CStr(dblS))
Rhino.print("dblT = " & CStr(dblT))
For i = 0 To (dblS-1)
arrResult01(i) = arrResultTrees(j)(i)
Next
For i = 0 To (dblT-1)
arrResult02(i) = arrResultTrees(j)(i+dblS)
Next

'call function
Call tree (10, arrResult01)
Call tree (10, arrResult02)
Next
Call Rhino.print("execution completed")



'----------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------
Function branch (strRtPts, strALLREFPts, dblNumber, dblBoundary)
refer branch function
End Function
'----------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------


'----------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------
Function tree (dblStemLength, arrBranches)
Dim arrResult()

'length of given branches
'---------------------------------------
Dim i
Dim blnFlag
blnFlag = False

For i=0 To UBound(arrBranches)
Dim dblCurveLength
dblCurveLength = Rhino.CurveLength (arrBranches(i))
Call Rhino.print("length = "& CStr(dblCurveLength))
If dblCurveLength > dblStemLength Then
blnFlag = True
End If
Next

'get average if branches are too long,
'---------------------------------------
If blnFlag Then
Rhino.print("blnFlag = true")
Dim arrEdPt, arrStPt
Dim arrAvgPt(2), dblX, dblY, dblZ
dblX = 0
dblY = 0
dblZ = 0
For i = 0 To UBound(arrBranches)
arrEdPt = Rhino.CurveEndPoint (arrBranches(i))
dblX = dblX + arrEdPt(0)
dblY = dblY + arrEdPt(1)
dblZ = dblZ + arrEdPt(2)
Next

arrAvgPt(0) = dblX /(UBound(arrBranches)+1)
arrAvgPt(1) = dblY /(UBound(arrBranches)+1)
arrAvgPt(2) = dblZ /(UBound(arrBranches)+1)
arrStPt = Rhino.CurveStartPoint (arrBranches(0))
Dim arrDiff
arrDiff = Rhino.VectorSubtract (arrAvgPt, arrStPt)
Dim dblDiff
dblDiff = Rhino.VectorLength (arrDiff)
Dim k
k = dblStemLength / dblDiff
arrDiff = Rhino.VectorScale (arrDiff, k)
Dim arrSeed
arrSeed = Rhino.VectorAdd (arrStPt, arrDiff)

'shorter branches
'---------------------------------------
Dim strNewBranches
ReDim strNewBranches(UBound(arrBranches))
For i = 0 To UBound(arrBranches)
Dim arrLeaf
arrLeaf = Rhino.CurveEndPoint(arrBranches(i))
Dim strLine
strLine = Rhino.AddLine(arrSeed, arrLeaf)
ReDim Preserve arrResult(i)
arrResult(i) = strLine
Next

Dim strStem
strStem = Rhino.AddLine (arrStPt, arrSeed)
Call Rhino.DeleteObjects (arrBranches)
Else
Rhino.print("blnFlag = false")
End If
'---------------------------------------

Call Rhino.CurrentLayer ("0")
tree = arrResult
End Function
'----------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------

makeBranch Revision

Option Explicit
'Author: YukiukiH
'Date: 08/10/03
'compatibility: Rhino4
''branching using vector

'first things first...
'----------------------------------------------------------------------------------------------
Dim strRtPts
strRtPts = Rhino.GetObjects ("select root points", 1)
Call Rhino.AddLayer ("ptCloudRT", RGB(0,0,0)) 'black
Call Rhino.ObjectLayer (strRtPts, "ptCloudRT")
Dim strALLREFPts
strALLREFPts = Rhino.GetObjects ("select reference points", 1)
Call Rhino.AddLayer ("ptCloudREF", RGB(105,105,105)) 'gray
Call Rhino.ObjectLayer (strALLREFPts, "ptCloudREF")
Dim dblNumber
dblNumber = 8 '4
Dim dblBoundary
dblBoundary = 100 '100
Call Rhino.Print ("minimize rhino window")

Call branch (strRtPts, strALLREFPts, dblNumber, dblBoundary)
Call Rhino.print("execution completed")



'----------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------
Function branch (strRtPts, strALLREFPts, dblNumber, dblBoundary)
Dim arrResult()

'coordinate extraction
'----------------------------------------------------------------------------------------------
Dim i, arrRtPts(), arrALLREFPts()
For i = 0 To UBound(strRtPts)
ReDim Preserve arrRtPts(i)
arrRtPts(i) = Rhino.PointCoordinates (strRtPts(i))
Next
For i = 0 To UBound(strALLREFPts)
ReDim Preserve arrALLREFPts(i)
arrALLREFPts(i) = Rhino.PointCoordinates (strALLREFPts(i))
Next

'for each RootPoint,
'----------------------------------------------------------------------------------------------
Dim dblmaxX, dblminX, dblmaxY, dblminY
Dim arrREFPts(), arrMinLength(), dblMinLength
Dim strShortests()
Dim j
For j = 0 To UBound(arrRtPts)
Call Rhino.Print ("Round " & CStr(j+1))

'set boundary
'---------------------------------------
dblmaxX = arrRtPts(j)(0) +dblBoundary
dblminX = arrRtPts(j)(0) -dblBoundary
dblmaxY = arrRtPts(j)(1) +dblBoundary
dblminY = arrRtPts(j)(1) -dblBoundary
Dim n, m
n = 0
For m = 0 To UBound(arrALLREFPts)
If dblmaxX>arrALLREFPts(m)(0) And arrALLREFPts(m)(0)>dblminX And dblmaxY>arrALLREFPts(m)(1) And arrALLREFPts(m)(1)>dblminY Then
ReDim Preserve arrREFPts(n)
arrREFPts(n) = arrALLREFPts(m)
n = n+1
End If
Next
'---------------------------------------


'find dblNumber shortest
'---------------------------------------
Dim arrVectorTemp, dblLengthTemp
Dim arrVector01, dblLength01
Dim arrPrevShortest, dblPrevShortest
Dim arrCurrShortest, dblCurrShortest
dblMinLength = 0

For i = 0 To dblNumber-1
'make one to begin comparison with
arrVectorTemp = Rhino.VectorCreate (arrREFPts(0), arrRtPts(j))
dblLengthTemp = Rhino.VectorLength (arrVectorTemp)
arrPrevShortest = arrVectorTemp
dblPrevShortest = dblLengthTemp

If dblPrevShortest <= dblMinLength Then
dblPrevShortest = dblPrevShortest * 100
End If

For n = 0 To UBound(arrREFPts)
arrVector01 = Rhino.VectorCreate (arrREFPts(n), arrRtPts(j))
dblLength01 = Rhino.VectorLength (arrVector01)

If dblLength01 <= dblPrevShortest And dblLength01 > dblMinLength Then
arrCurrShortest = arrVector01
dblCurrShortest = dblLength01
Else
arrCurrShortest = arrPrevShortest
dblCurrShortest = dblPrevShortest
End If

'prepare for next round
arrPrevShortest = arrCurrShortest
dblPrevShortest = dblCurrShortest

Next 'arrREFPts
ReDim Preserve arrMinLength(i)
arrMinLength(i) = arrCurrShortest
dblMinLength = dblCurrShortest
Call Rhino.Print (CStr(i+1) & " shortest:" & " " & CStr(dblMinLength))

Call Rhino.AddLayer (CStr(i+1) & " shortest", RGB(255-i*20, 50+i*24, 0))
Call Rhino.CurrentLayer (CStr(i+1) & " shortest")

ReDim Preserve strShortests(i)
strShortests(i) = Rhino.Addline (arrRtPts(j), Rhino.VectorAdd (arrRtPts(j), arrMinLength(i)))

Next 'i
ReDim Preserve arrResult(j)
arrResult(j) = strShortests
'---------------------------------------
Next 'j

Call Rhino.CurrentLayer ("0")
branch = arrResult
End Function
'----------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------

makeBridge Revision

Option Explicit
'Author: YukiukiH
'Date: 08/10/03
'compatibility: Rhino4
''draw normal at each division point using vector
''then create bridge structure


'first things first...
'----------------------------------------------------------------------------------------------
Call Rhino.AddLayer ("splineCenter", RGB(255,0,0)) 'black
Call Rhino.AddLayer ("centerPt", RGB(0,0,0)) 'black
Call Rhino.AddLayer ("normalAxis", RGB(0,0,0)) 'black
Call Rhino.AddLayer ("normal01", RGB(255,161,0)) 'gold
Call Rhino.AddLayer ("normal02", RGB(255,127,0)) 'orange
Call Rhino.AddLayer ("side01", RGB(0,0,0)) 'black
Call Rhino.AddLayer ("side02", RGB(0,0,0)) 'black
Call Rhino.AddLayer ("Pt", RGB(0,0,0)) 'black
Call Rhino.AddLayer ("Line011", RGB(63,191,191)) 'turquoise
Call Rhino.AddLayer ("Line022", RGB(63,191,191)) 'turquoise
Call Rhino.AddLayer ("Line033", RGB(0,0,0)) 'black
Call Rhino.AddLayer ("Line044", RGB(0,0,0)) 'black
Call Rhino.AddLayer ("Line055", RGB(255,0,0)) 'red

Dim strSpline
strSpline = Rhino.GetObject ("select a spline curve", 4)
Call Rhino.ObjectLayer (strSpline , "splineCenter")
Call Rhino.LayerVisible ("splineCenter", False)
Dim dblsegLength
dblsegLength = 1500 '1500
Dim dblWidth
dblWidth = 2000 '2000
Dim dblSideAngle
dblSideAngle = 100 '100
Dim dblSideHeight
dblSideHeight = 900 '900
Dim dblDiagLength
dblDiagLength = dblSideHeight*Sec(dblSideAngle-90)
Call Rhino.Print (dblDiagLength) '913.884

Function Sec(x)
Dim dblPi
dblPi = Rhino.Pi
Sec = 1 / Cos(x*2*dblPi/360)
End Function

Call ribaBridge (strSpline, dblSegLength, dblWidth, dblSideAngle, dblDiagLength)
Call Rhino.print("execution completed")



'----------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------
Function ribaBridge (strSpline, dblSegLength, dblWidth, dblSideAngle, dblDiagLength)

'division points
'---------------------------------------
Dim arrCenPts, strCenPt
Dim a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z

If Rhino.IsCurve(strSpline) Then
'by length segment
arrCenPts = Rhino.DivideCurveLength(strSpline, dblSegLength)
'by segments
'intSegments = 130
'arrPoints = Rhino.DivideCurve(strSpline, intSegments)
Call Rhino.CurrentLayer ("centerPt")
For i = 0 To UBound(arrCenPts)
strCenPt = Rhino.AddPoint (arrCenPts(i))
Next
End If

'normal
'---------------------------------------
Dim dblParam, arrTangents(), arrNormals()
Dim strNormalSides01(), strNormalSides02()

For i = 0 To UBound(arrCenPts)
dblParam = Rhino.CurveClosestPoint(strSpline, arrCenPts(i))
ReDim Preserve arrTangents(i)
arrTangents(i) = Rhino.CurveTangent(strSpline, dblParam)
ReDim Preserve arrNormals(i)
arrNormals(i) = Rhino.VectorCrossProduct(arrTangents(i), Array(0,0,1))
ReDim Preserve arrNormals(i)
arrNormals(i) = Rhino.VectorUnitize(arrNormals(i))
ReDim Preserve arrNormals(i)
arrNormals(i) = Rhino.VectorScale(arrNormals(i), dblWidth)

Call Rhino.CurrentLayer ("normal01")
ReDim Preserve strNormalSides01(i)
strNormalSides01(i) = Rhino.addLine(arrCenPts(i), Rhino.VectorAdd(arrCenPts(i), arrNormals(i)))
ReDim Preserve strNormalSides02(i)
strNormalSides02(i) = Rhino.RotateObject (strNormalSides01(i), arrCenPts(i), 180, Array(0,0,1), True)
Call Rhino.ObjectLayer (strNormalSides02(i), "normal02")
Next

'prepare vector for 3d rotation
'---------------------------------------
Dim arrAxiss(), arrSides(), dilDiagLength(), strSides01, strSides02
Dim arrSides01EdPts(), arrSides02EdPts()
Dim arrSides01TpPts(), arrSides02TpPts()

For i = 0 To UBound(arrCenPts)
ReDim Preserve arrSides01EdPts(i)
arrSides01EdPts(i) = Rhino.CurveEndPoint (strNormalSides01(i))
ReDim Preserve arrSides02EdPts(i)
arrSides02EdPts(i) = Rhino.CurveEndPoint (strNormalSides02(i))

ReDim Preserve arrAxis(i)
arrAxis(i) = Rhino.VectorRotate (arrNormals(i), -90, Array(0,0,1))
ReDim Preserve arrSides(i)
arrSides(i) = Rhino.VectorRotate (arrNormals(i), 180-dblSideAngle, arrAxis(i))
ReDim Preserve arrSides(i)
arrSides(i) = Rhino.VectorUnitize (arrSides(i))
ReDim Preserve arrSides(i)
arrSides(i) = Rhino.VectorScale (arrSides(i), dblDiagLength)

Call Rhino.CurrentLayer ("side01")
strSides01 = Rhino.addLine (arrSides01EdPts(i), Rhino.VectorAdd(arrSides01EdPts(i), arrSides(i)))
ReDim Preserve arrSides(i)
arrSides(i) = Rhino.VectorRotate (arrSides(i), (dblSideAngle-90)*2, arrAxis(i))
Call Rhino.CurrentLayer ("side02")
strSides02 = Rhino.addLine (arrSides02EdPts(i), Rhino.VectorAdd(arrSides02EdPts(i), arrSides(i)))

'add points
ReDim Preserve arrSides01TpPts(i)
arrSides01TpPts(i) = Rhino.CurveEndPoint (strSides01)
ReDim Preserve arrSides02TpPts(i)
arrSides02TpPts(i) = Rhino.CurveEndPoint (strSides02)

Call Rhino.CurrentLayer ("Pt")
Call Rhino.AddPoint (arrSides01EdPts(i))
Call Rhino.AddPoint (arrSides02EdPts(i))
Call Rhino.AddPoint (arrSides01TpPts(i))
Call Rhino.AddPoint (arrSides02TpPts(i))
Next

'create lines between (i) and (i+1)
'---------------------------------------
Dim strLine011, strLine022, strLine033, strLine044, strLine055

For i = 0 To UBound(arrCenPts)-1
Call Rhino.CurrentLayer ("Line011")
strLine011 = Rhino.AddLine (arrSides01EdPts(i), arrSides01EdPts(i+1))
Call Rhino.CurrentLayer ("Line022")
strLine022 = Rhino.AddLine (arrSides02EdPts(i), arrSides02EdPts(i+1))
Call Rhino.CurrentLayer ("Line033")
strLine033 = Rhino.AddLine (arrSides01TpPts(i), arrSides01TpPts(i+1))
Call Rhino.CurrentLayer ("Line044")
strLine044 = Rhino.AddLine (arrSides02TpPts(i), arrSides02TpPts(i+1))
Call Rhino.CurrentLayer ("Line055")
strLine055 = Rhino.AddLine (arrCenPts(i), arrCenPts(i+1))
Next

End Function
'----------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------