Difference between revisions of "MakeBranch Revision-ssss"
From scripting
(Created page with "Direct: http://ssssociety.blogspot.com/2008/09/makebranch-revision.html Option Explicit 'Author: YukiukiH 'Date: 08/10/03 'compatibility: Rhino4 'branching using vecto...") |
(No difference)
|
Latest revision as of 07:21, 22 April 2017
Direct: http://ssssociety.blogspot.com/2008/09/makebranch-revision.html
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 '---------------------------------------------------------------------------------------------- '----------------------------------------------------------------------------------------------