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
'----------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------
