Superficie Reactiva 2

Este script identifica una superfice cualquiera,donde imprime sobre ella una matriz de puntos con los que construye por cada 4 puntos una segunda superfice, una curva cerrada y una polilinea.

Desde el centro de la segunda Superfice se calcula una normal, que será el camino por el cual la curva cerrada sera copiada.

Luego de que la Curva se encuentre en el extremo de la "Normal" está es escalada por un factor y a continuación se realiza una superficie de transición entre la curva cerrada escalada y la polilinea.

Script:

Option Explicit
'carlos de la b. diciembre2006

Call FaceteadoSuperficie()
Sub FaceteadoSuperficie()
   
'declaracion de variables
Dim strSurface
Dim arrDomainU, arrDomainV
Dim arrParamU, arrParamV, arrPoint
Dim i, j
Dim secu, secv

'divisiones de superficie
secu = 16     'numero de columnas
   secv = 16   'numero de puntos por columna

'declaracion de matrices
ReDim colec2d(secu,secv)

'input
strSurface = Rhino.GetObject("Seleccione superficie")
If IsNull(strSurface) Then Exit Sub

arrDomainU = Rhino.SurfaceDomain(strSurface, 0)
arrDomainV = Rhino.SurfaceDomain(strSurface, 1)

'loop
For i = 0 To secu
  For j = 0 To secv

'divisiones
arrParamU = arrDomainU(0) + i * (arrDomainU(1) - arrDomainU(0)) / secu
      arrParamV = arrDomainV(0) + j * (arrDomainV(1) - arrDomainV(0)) / secv
     
arrPoint = Rhino.EvaluateSurface(strSurface, Array(arrParamU, arrParamV))
   Rhino.AddPoint arrPoint

colec2d(i,j) = arrPoint

  Next
Next

'matrix
Dim esquina1
Dim esquina2
Dim esquina3
Dim esquina4
Dim Curva, QuadSurface, Edge
Dim newarrPoint, Normal, LineNormal, path

'valores de la coleccion
esquina1 = colec2d(1,1)
   esquina2 = colec2d(1,2)
      esquina3 = colec2d(2,2)
         esquina4 = colec2d(2,1)

'loop matrix
For i = 0 To (secu - 1)
 For j = 0 To (secv - 1)

esquina1 = colec2d(i,j)
   esquina2 = colec2d(i + 1,j)
      esquina3 = colec2d(i + 1,j + 1)
         esquina4 = colec2d(i,j + 1)

'llamada de funciones
Dim quad: quad = mifuncionplacas(esquina1,esquina2,esquina3,esquina4, Curva, QuadSurface, Edge)
Dim GetNormal: GetNormal = mifuncionNormal(newarrPoint, Normal, LineNormal, path, QuadSurface) 
Dim Chupon: Chupon = mifuncionVentosa(Curva, newarrPoint, path, Edge)
Dim Escondida: Escondida = mifuncionHide(strSurface, QuadSurface)

   Next
Next
End Sub

'funciones
Function mifuncionplacas(esquina1, esquina2, esquina3, esquina4, Curva, QuadSurface, Edge)
QuadSurface = Rhino.AddSrfPt(Array(esquina1, esquina2, esquina3, esquina4))
      Curva =  Rhino.AddCurve(Array(esquina1, esquina2, esquina3, esquina4, esquina1))
          Edge = Rhino.addPolyline(Array(esquina1, esquina2, esquina3, esquina4, esquina1))
End Function 


Function mifuncionNormal(newarrPoint, Normal, LineNormal, path, QuadSurface)
Dim newDomainU, newDomainV
Dim newarrParameterU, newarrParameterV

newDomainU = Rhino.SurfaceDomain(QuadSurface,0)
      newDomainV = Rhino.SurfaceDomain(QuadSurface,1)
 
newarrParameterU = (newDomainU(1) - newDomainU(0))/2
      newarrParameterV = (newDomainV(1) - newDomainV(0))/2 

newarrPoint = Rhino.EvaluateSurface(QuadSurface, Array(newarrParameterU, newarrParameterV))
    Rhino.AddPoint newarrPoint
        
        Normal = Rhino.SurfaceNormal(QuadSurface, Array(newarrParameterU, newarrParameterV))
           LineNormal = Rhino.addLine (newarrPoint, Rhino.VectorAdd(newarrPoint, Normal))
              path = Rhino.ExtendCurveLength (LineNormal, 0, 1, 18)
End Function


Function mifuncionVentosa(Curva, newarrPoint, path, Edge)
Dim arrEnd
Dim pathDomain, pathParameter
  
  pathDomain = Rhino.CurveDomain(path)
      pathParameter = pathDomain(1)
        arrEnd = Rhino.EvaluateCurve(path, pathParameter)
            Rhino.AddPoint arrEnd
      
                Rhino.MoveObject Curva, newarrPoint, arrEnd
                    Rhino.ScaleObject Curva, arrEnd, Array(.8, .8, .8)
                        Rhino.AddLoftSrf Array(Curva, Edge),,,3
End Function


Function mifuncionHide(strSurface, QuadSurface)
 Rhino.HideObject (strSurface)
      Rhino.HideObjects Array(QuadSurface)
End Function