S.S.S.S. is about collaboration, cooperation and innovation. A community database of things related to scripting, parametric modeling, and digital project.
'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 '---------------------------------------------------------------------------------------------- '----------------------------------------------------------------------------------------------
'---------------------------------------------------------------------------------------------- '---------------------------------------------------------------------------------------------- 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 '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
'---------------------------------------------------------------------------------------------- '---------------------------------------------------------------------------------------------- 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()
'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))
End Function '---------------------------------------------------------------------------------------------- '----------------------------------------------------------------------------------------------
