** Updated Branching Script
Very simple operation to find closest point out of point cloud. I have some more work to do on this script, so I wanted to post it up before I make it too complicated.
Each Loop finds first closest, second closest, third closest, so on and so forth. I thought it would be cool to set a variable that defines how many closest point each target has to find, but I couldn't figure out. Let's just start with recycling the same Loop over and over again.
It looks like I can make this script much shorter if
Call Rhino.PointArrayClosestPoint (arrPoints( ), arrPoint)
works... This sample appears in monkey, yet somehow Rhino Script Method is not available.
'----------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------
Option Explicit
'Author: YukiukiH
'Date: 06/04/2008
'compatibility: Rhino4
'memo: boundary is variable in plan
Branching()
Sub Branching()
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
Dim arrstrStPt, arrStPt()
Dim arrstrEdPt(), arrEdPt()
Dim arrstrALLEdPt, arrALLEdPt()
'user selection
arrstrStPt = Rhino.GetObjects ("select root points", 1)
arrstrALLEdPt = Rhino.GetObjects ("select reference points", 1)
Rhino.Print "MINIMIZE RHINO WHINDOW TO SAVE TIME !!!"
For i = 0 To UBound(arrstrStPt)
ReDim Preserve arrStPt(i)
arrStPt(i) = Rhino.PointCoordinates (arrstrStPt(i))
Next
For i = 0 To UBound(arrstrALLEdPt)
ReDim Preserve arrALLEdPt(i)
arrALLEdPt(i) = Rhino.PointCoordinates (arrstrALLEdPt(i))
Next
'set boundary
'----------------------------------------------------------------------------------------------
Dim dblmaxX, dblminX, dblmaxY, dblminY
'Ultimate Loop
b = 100
For j = 0 To UBound(arrStPt)
dblmaxX = arrStPt(j)(0) +b
dblminX = arrStPt(j)(0) -b
dblmaxY = arrStPt(j)(1) +b
dblminY = arrStPt(j)(1) -b
n = 0
For m = 0 To UBound(arrstrALLEdPt)
If dblmaxX > arrALLEdPt(m)(0) And arrALLEdPt(m)(0) > dblminX And dblmaxY > arrALLEdPt(m)(1) And arrALLEdPt(m)(1) > dblminY Then
ReDim Preserve arrstrEdPt(n)
arrstrEdPt(n) = Rhino.CopyObject (arrstrALLEdPt(m))
ReDim Preserve arrEdPt(n)
arrEdPt(n) = Rhino.PointCoordinates (arrstrEdPt(n))
n = n+1
End If
Next
Call Rhino.DeleteObjects (arrstrEdPt)
'----------------------------------------------------------------------------------------------
'comparison
Dim strLine01, dblDist01
Dim strLine02, dblDist02
Dim strPrevShortest, dblPrevShortest
Dim strCurrShortest, dblCurrShortest
'find shortest
'----------------------------------------------------------------------------------------------
i = 0 'make one to begin comparison with
strLine01 = Rhino.AddLine (arrStPt(j), arrEdPt(i))
dblDist01 = Rhino.CurveLength (strLine01)
strPrevShortest = strLine01
dblPrevShortest = dblDist01
For i = 0 To UBound(arrEdPt)
strLine02 = Rhino.AddLine (arrStPt(j), arrEdPt(i))
dblDist02 = Rhino.CurveLength (strLine02)
If dblDist02 <= dblPrevShortest Then
strCurrShortest = strLine02
dblCurrShortest = dblDist02
Rhino.DeleteObject strPrevShortest
Else
strCurrShortest = strPrevShortest
dblCurrShortest = dblPrevShortest
Rhino.DeleteObject strLine02
End If
'prepare for next round
strPrevShortest = strCurrShortest
dblPrevShortest = dblCurrShortest
'Rhino.Sleep 10
Next
'----------------------------------------------------------------------------------------------
'find second
'----------------------------------------------------------------------------------------------
Rhino.AddLayer "1st shortest", RGB(0,255,255) 'cyan
Rhino.ObjectLayer strCurrShortest, "1st shortest"
Dim dbl1stShortest, str1stShortest
dbl1stShortest = Rhino.CurveLength (strPrevShortest)
str1stShortest = strPrevShortest
i = 0 'make one to begin comparison with
strLine01 = Rhino.AddLine (arrStPt(j), arrEdPt(i))
dblDist01 = Rhino.CurveLength (strLine01)
If dblDist01 <= dbl1stShortest Then
dblDist01 = dblDist01 * 10
End If
strPrevShortest = strLine01
dblPrevShortest = dblDist01
For i = 0 To UBound(arrEdPt)
strLine02 = Rhino.AddLine (arrStPt(j), arrEdPt(i))
dblDist02 = Rhino.CurveLength (strLine02)
If dblDist02 <= dblPrevShortest And dblDist02 > dbl1stShortest Then
strCurrShortest = strLine02
dblCurrShortest = dblDist02
Rhino.DeleteObject strPrevShortest
Else
strCurrShortest = strPrevShortest
dblCurrShortest = dblPrevShortest
Rhino.DeleteObject strLine02
End If
'prepare for next round
strPrevShortest = strCurrShortest
dblPrevShortest = dblCurrShortest
'Rhino.Sleep 10
Next
'----------------------------------------------------------------------------------------------
'find third
'----------------------------------------------------------------------------------------------
Rhino.AddLayer "2nd shortest", RGB(0,0,191) 'dark blue
Rhino.ObjectLayer strCurrShortest, "2nd shortest"
Dim dbl2ndShortest, str2ndShortest
dbl2ndShortest = Rhino.CurveLength (strPrevShortest)
str2ndShortest = strPrevShortest
i = 0 'make one to begin comparison with
strLine01 = Rhino.AddLine (arrStPt(j), arrEdPt(i))
dblDist01 = Rhino.CurveLength (strLine01)
If dblDist01 <= dbl2ndShortest Then
dblDist01 = dblDist01 * 10
End If
strPrevShortest = strLine01
dblPrevShortest = dblDist01
For i = 0 To UBound(arrEdPt)
strLine02 = Rhino.AddLine (arrStPt(j), arrEdPt(i))
dblDist02 = Rhino.CurveLength (strLine02)
If dblDist02 <= dblPrevShortest And dblDist02 > dbl2ndShortest Then
strCurrShortest = strLine02
dblCurrShortest = dblDist02
Rhino.DeleteObject strPrevShortest
Else
strCurrShortest = strPrevShortest
dblCurrShortest = dblPrevShortest
Rhino.DeleteObject strLine02
End If
'prepare for next round
strPrevShortest = strCurrShortest
dblPrevShortest = dblCurrShortest
'Rhino.Sleep 10
Next
'----------------------------------------------------------------------------------------------
'find fourth
'----------------------------------------------------------------------------------------------
Rhino.AddLayer "3rd shortest", RGB(127,255,191) 'Aquamarine
Rhino.ObjectLayer strCurrShortest, "3rd shortest"
Dim dbl3rdShortest, str3rdShortest
dbl3rdShortest = Rhino.CurveLength (strPrevShortest)
str3rdShortest = strPrevShortest
i = 0 'make one to begin comparison with
strLine01 = Rhino.AddLine (arrStPt(j), arrEdPt(i))
dblDist01 = Rhino.CurveLength (strLine01)
If dblDist01 <= dbl3rdShortest Then
dblDist01 = dblDist01 * 10
End If
strPrevShortest = strLine01
dblPrevShortest = dblDist01
For i = 0 To UBound(arrEdPt)
strLine02 = Rhino.AddLine (arrStPt(j), arrEdPt(i))
dblDist02 = Rhino.CurveLength (strLine02)
If dblDist02 <= dblPrevShortest And dblDist02 > dbl3rdShortest Then
strCurrShortest = strLine02
dblCurrShortest = dblDist02
Rhino.DeleteObject strPrevShortest
Else
strCurrShortest = strPrevShortest
dblCurrShortest = dblPrevShortest
Rhino.DeleteObject strLine02
End If
'prepare for next round
strPrevShortest = strCurrShortest
dblPrevShortest = dblCurrShortest
'Rhino.Sleep 10
Next
'----------------------------------------------------------------------------------------------
'paste above here
'----------------------------------------------------------------------------------------------
Rhino.AddLayer "final shortest", RGB(255,255,255) 'white
Rhino.ObjectLayer strCurrShortest, "final shortest"
Dim dblFinalShortest, strFinalShortest
dblFinalShortest = Rhino.CurveLength (strPrevShortest)
strFinalShortest = strPrevShortest
Next
'----------------------------------------------------------------------------------------------
Call Rhino.Print ("script complete")
End Sub
