Difference between revisions of "Boundary Cube-ssss"
From scripting
(Created page with "Direct: http://ssssociety.blogspot.com/2008/10/bounday-cube.html Option Explicit 'Author: YukiukiH 'Date: 10/08/2008 'compatibility: Rhino4 'boundary CUBE '----------...") |
(No difference)
|
Latest revision as of 04:55, 22 April 2017
Direct: http://ssssociety.blogspot.com/2008/10/bounday-cube.html
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 '---------------------------------------------------------------------------------------------- '----------------------------------------------------------------------------------------------