http://nickpisca.com/BLAST/index.php?title=Boundary_Partial_Sphere-ssss&feed=atom&action=history
Boundary Partial Sphere-ssss - Revision history
2024-03-28T14:53:46Z
Revision history for this page on the wiki
MediaWiki 1.28.1
http://nickpisca.com/BLAST/index.php?title=Boundary_Partial_Sphere-ssss&diff=24&oldid=prev
Nickpisca: Created page with "Direct: http://ssssociety.blogspot.com/2008/10/boundary-partial-sphere.html Option Explicit 'Author: YukiukiH 'Date: 10/08/2008 'compatibility: Rhino4 ''boundary PARTIA..."
2017-04-22T04:56:35Z
<p>Created page with "Direct: http://ssssociety.blogspot.com/2008/10/boundary-partial-sphere.html Option Explicit 'Author: YukiukiH 'Date: 10/08/2008 'compatibility: Rhino4 ''boundary PARTIA..."</p>
<p><b>New page</b></p><div>Direct: http://ssssociety.blogspot.com/2008/10/boundary-partial-sphere.html<br />
<br />
<br />
Option Explicit<br />
'Author: YukiukiH<br />
'Date: 10/08/2008<br />
'compatibility: Rhino4<br />
''boundary PARTIAL SPHERE<br />
'----------------------------------------------------------------------------------------------<br />
Dim strTrgPt, arrTrgPt<br />
strTrgPt = Rhino.GetObject ("select a target point", 1)<br />
Dim strALLRefPts<br />
strALLRefPts = Rhino.GetObjects ("select reference points", 1)<br />
Dim strPtDir, arrPtDir, arrDirVector<br />
strPtDir = Rhino.GetObject ("select a point for direction", 1)<br />
Dim strRefPts<br />
strRefPts = boundaryPartialSphere (strTrgPt, strALLRefPts, strPtDir, 450, 30)<br />
<br />
'color<br />
Dim intR, intG, intB<br />
Dim i<br />
For i = 0 To UBound(strRefPts)<br />
intR =255<br />
intG =25+i*Rnd()*2<br />
intB =0<br />
Call Rhino.ObjectColor (strRefPts(i), RGB(intR, intG, intB))<br />
Next<br />
Call Rhino.print("execution completed")<br />
<br />
<br />
'----------------------------------------------------------------------------------------------<br />
'----------------------------------------------------------------------------------------------<br />
Function boundaryPartialSphere (strTrgPt, strALLRefPts, strPtDir, dblBoundR, dblBoundAngle)<br />
Dim arrResult<br />
<br />
'coordinate extraction<br />
'---------------------------------------<br />
Dim arrTrgPt<br />
arrTrgPt = Rhino.PointCoordinates (strTrgPt)<br />
Dim arrALLRefPts()<br />
Dim i<br />
For i = 0 To UBound(strALLRefPts)<br />
ReDim Preserve arrALLRefPts(i)<br />
arrALLRefPts(i) = Rhino.PointCoordinates (strALLRefPts(i))<br />
Next<br />
Dim arrPtDir<br />
arrPtDir = Rhino.PointCoordinates (strPtDir)<br />
<br />
'set boundary<br />
'---------------------------------------<br />
Dim dblDist, dblAngles, arrDir<br />
Dim arrLine1(1), arrLine2(1)<br />
Dim arrREFPts(), strRefPts()<br />
Dim n, m<br />
n = 0<br />
For m = 0 To UBound(arrALLRefPts)<br />
dblDist = Rhino.Distance (arrTrgPt, arrALLRefPts(m))<br />
<br />
If dblDist < dblBoundR Then<br />
arrLine1(0) = arrPtDir<br />
arrLine1(1) = arrTrgPt<br />
arrLine2(0) = arrALLRefPts(m)<br />
arrLine2(1) = arrTrgPt<br />
dblAngles = Rhino.Angle2 (arrLine1, arrLine2)<br />
If dblAngles(0) < dblBoundAngle Then<br />
Call Rhino.Print ("through point: " & CStr(n+1))<br />
ReDim Preserve arrRefPts(n)<br />
arrRefPts(n) = arrALLRefPts(m)<br />
ReDim Preserve strRefPts(n)<br />
strRefPts(n) = strALLRefPts(m)<br />
n = n+1<br />
End If<br />
End If<br />
<br />
Next<br />
'---------------------------------------<br />
arrResult = strRefPts<br />
boundaryPartialSphere = arrResult<br />
End Function<br />
'----------------------------------------------------------------------------------------------<br />
'----------------------------------------------------------------------------------------------<br />
<br />
<br />
<br />
<br />
[[Category:RhinoScript]]</div>
Nickpisca