skip to main |
skip to sidebar
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
'----------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------
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
'----------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------
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
'----------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------
