Rh4_060810_Vorono_2D&1/2
from 2D to "transferOntoSrf"; some sort of 2&1/2D...
' ------------------------------------------------------
' Function transfertPtOntoSrf
Function TransfertPtsOnSrf(arrPt, BBox, targetSrf)
Dim strpolyline, strPlanSrf
Dim tempUVPt
Dim sDomU_PlanSrf, sDomV_PlanSrf
strpolyline = Rhino.AddPolyline(Array(Array(BBox(0)(0)-10, BBox(0)(1)-10, 0), _
Array(BBox(1)(0)+10, BBox(1)(1)-10, 0), _
Array(BBox(2)(0)+10, BBox(2)(1)+10, 0), _
Array(BBox(3)(0)-10, BBox(3)(1)+10, 0), _
Array(BBox(0)(0)-10, BBox(0)(1)-10, 0)))
strPlanSrf = Rhino.addPlanarSrf (Array(strpolyline))
' ------------------------------------------------------
'reparameterize the UV domain of the target surface to match the source surface
sDomU_PlanSrf = Rhino.SurfaceDomain(strPlanSrf(0), 0)
sDomV_PlanSrf = Rhino.SurfaceDomain(strPlanSrf(0), 1)
Rhino.UnselectAllObjects
Rhino.SelectObject targetSrf
Rhino.command("-_Reparameterize " & sDomU_PlanSrf(0) & " " & sDomU_PlanSrf(1) & " " & sDomV_PlanSrf(0) & " " & sDomV_PlanSrf(1) & " ")
' ------------------------------------------------------
tempUVPt = Rhino.SurfaceClosestPoint(strPlanSrf(0), arrPt)
TransfertPtsOnSrf = Rhino.EvaluateSurface(targetSrf, tempUVPt)
' Rhino.addpoint TransfertPtsOnSrf
Rhino.deleteObjects Array(strPolyline,strPlanSrf(0))
End Function
' ------------------------------------------------------
<< Home