Option Explicit
‘Script written by ben howell
‘Script copyrighted by md + x
‘Script version Tuesday, October 16, 2007 11:41:44 PM
Call Main()
Sub Main()
‘this will create tubes along isoparms with r = to 1/distancePtCompare
Dim arrPtObj : arrPtObj = Rhino.GetPoint(“pick a point to compare”)
Rhino.AddPoint(arrPtObj)
Dim uParam, vParam
Dim strSrf : strSrf = Rhino.GetObject(“pick the surface you would like to transform”,
Dim divV : divV = Rhino.GetReal(“enter the number of divisions in y”)
Dim divU : divU = Rhino.GetReal(“enter the number of divisions in u”)
Dim arrSurfParaU : arrSurfParaU = Rhino.SurfaceDomain(strSrf, 0)
Dim arrSurfParaV : arrSurfParaV = Rhino.SurfaceDomain(strSrf, 1)
ReDim arrParam(divU, divV)
Dim n : n = 0
Dim i,j
Dim uVal, vVal
For i = 0 To divV
For j = 0 To divU
Rhino.EnableRedraw(False)
ReDim arrPt(divV,divU)
ReDim Preserve arrRadius(n)
uVal = (arrSurfParaU(1)-arrSurfParaU(0))/divU*i
vVal = (arrSurfParaV(1)-arrSurfParaV(0))/divV*j
arrPt(i,j) = Rhino.EvaluateSurface(strSrf, Array(uVal, vVal))
arrParam(i,j) = Rhino.SurfaceClosestPoint(strSrf, arrPt(i,j))
arrRadius(n) = Rhino.Distance(arrPt(i,j),arrPtObj)
n = n+1
Next
Next
For i = 0 To divV
Rhino.ExtractIsoCurve strSrf, arrParam(i,0), 1
Next
For j = 0 To divU
Rhino.ExtractIsoCurve strSrf, arrParam(0,j), 0
Next
Dim arrIsoParms : arrIsoParms = Rhino.ObjectsByType(4, vbFalse)
Dim m : m = 0
For i=0 To UBound(arrIsoParms)
Rhino.SelectObject (arrIsoParms(i))
Rhino.command “_pipe _thick=no _cap=flat ” & (1/arrRadius(m))* 200 & ” _enter” & ” _enter” & ” _enter”
Call Rhino.Print(arrRadius(m))
Rhino.UnselectObject(arrIsoParms(i))
Rhino.DeleteObject(strSrf)
m = m + 1
Next
Rhino.EnableRedraw(True)
End Sub
1 response so far ↓
Maria de la Guardia // December 11, 2007 at 10:24 pm |
Hello,
Thank you for the script, it is exactly what I am looking for – I am new to Rhino and am curious if I can apply this script to different contours and various sizes? If so, can you please explain how?
Thank you,
Maria