Option Explicit
'Author: YukiukiH
'Date: 10/08/2008
'compatibility: Rhino4
''boundary CUBE
'----------------------------------------------------------------------------------------------
Dim strTrgPt
strTrgPt = Rhino.GetObject ("select a target point", 1)
Dim strALLRefPts
strALLRefPts = Rhino.GetObjects ("select reference points", 1)
Dim strRefPts
strRefPts = boundaryCube (strTrgPt, strALLRefPts, 300, 300, 400)
'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 boundaryCube (strTrgPt, strALLRefPts, dblBoundX, dblBoundY, dblBoundZ)
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 dblmaxX, dblminX, dblmaxY, dblminY, dblmaxZ, dblminZ
Dim arrREFPts(), strRefPts()
dblmaxX = arrTrgPt(0) +(dblBoundX/2)
dblminX = arrTrgPt(0) -(dblBoundX/2)
dblmaxY = arrTrgPt(1) +(dblBoundY/2)
dblminY = arrTrgPt(1) -(dblBoundY/2)
dblmaxZ = arrTrgPt(2) +(dblBoundZ/2)
dblminZ = arrTrgPt(2) -(dblBoundZ/2)
Dim n, m
n = 0
For m = 0 To UBound(arrALLRefPts)
If dblmaxX>arrALLRefPts(m)(0) And arrALLRefPts(m)(0)>dblminX Then
If dblmaxY>arrALLRefPts(m)(1) And arrALLRefPts(m)(1)>dblminY Then
If dblmaxZ>arrALLRefPts(m)(2) And arrALLRefPts(m)(2)>dblminZ 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
End If
End If
Next
'---------------------------------------
arrResult = strRefPts
boundaryCube = arrResult
End Function
'----------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------
