'<生成三角形屋顶>

'版权所有(C)2009 <清华大学建筑学院人居环境模拟实验室>

'本程序为自由软件；您可依据自由软件基金会所发表的GNU 通用公共授权条款，对本程
'序再次发布和/或修改；无论您依据的是本授权的第三版，或（您可选的）任一日后发
'行的版本。
'本程序是基于使用目的而加以发布，然而不负任何担保责任；亦无对适售性或特定目的
'适用性所为的默示性担保。详情请参照GNU 通用公共授权。
'您应已收到附随于本程序的GNU 通用公共授权的副本；如果没有，请参照
'   <http://www.gnu.org/licenses/>.

'基于 GPL 的软件允许商业化销售，但不允许封闭源代码。在一个软件产品中使用("使用"
'指类库引用，修改后的代码或者衍生代码)此源代码，则该软件产品必须继承 GPL 协议，
'不允许封闭源代码。

'Do man want thick road.(做人要厚道)

Option Explicit
'Script written by <王韶宁>
'Script copyrighted by <清华大学建筑学院人居环境模拟实验室>
'Script version 2009年1月7日 19:47:42

Dim dbThickness
dbThickness = 0.5
Dim hight_ratio
hight_ratio = 1.4

Call Main()
Sub Main()
   
   '请用户选择brep
   Dim strBrep
   strBrep = Rhino.GetObject("Select a brep", 24)
   If IsNull(strBrep) Then
      Exit Sub
   End If
         
   '请用户选择最大的高度
   Dim maxHeight
   maxHeight = Rhino.GetReal("Max height", 50, 1.0,100)
   If IsNull(maxHeight) Then
      Exit Sub
   End If
   
   '请用户选择左下点
   Dim arrLeftDownPt, arrRightUpPt
   arrLeftDownPt = Rhino.GetPoint("Pick Left Down Point")

   If Not IsArray(arrLeftDownPt) Then
      Exit Sub
   End If

   '请用户选择右上点
   arrRightUpPt = Rhino.GetPoint("Pick Right Up Point", arrLeftDownPt)
   If Not IsArray(arrRightUpPt) Then
      Exit Sub
   End If
   
   '请用户输入有多少列
   Dim col
   col = Rhino.GetInteger("请输入列数，（不要超过100）")
   If IsNull(col) Then
      Exit Sub
   End If

   
   '请用户输入有多少行
   Dim row
   row = Rhino.GetInteger("请输入行数，（不要超过100）")
   If IsNull(row) Then
      Exit Sub
   End If
   
   '建立2维数组
   Dim arrBasePoint(102,102)
   
   '建立底部的数组的坐标
   '
   Dim min_x, max_x, range_x, min_y, max_y, range_y
   
   range_x = abs(arrRightUpPt(0)-arrLeftDownPt(0))/col
   range_y = abs(arrRightUpPt(1)-arrLeftDownPt(1))/row
   
   
   if(arrRightUpPt(0)-arrLeftDownPt(0))<0 then
      min_x = arrRightUpPt(0)
      max_x = arrLeftDownPt(0)
   else
      max_x = arrRightUpPt(0)
      min_x = arrLeftDownPt(0)
   End If
   
   If(arrRightUpPt(1)-arrLeftDownPt(1))<0 Then
      min_y = arrRightUpPt(1)
      max_y = arrLeftDownPt(1)
   else
      max_y = arrRightUpPt(1)
      min_y = arrLeftDownPt(1)
   End If

   Dim j,k
   Call Rhino.enableredraw(False)
   For j =0 To row Step 1
      For k=0 To col Step 1
         arrBasePoint(j,k)=Array(min_x+range_x*k,min_y+ range_y*j,0)
         '   arrBasePoint(j,k)=
         
         '画线，求交得出在brep面上的交点
         Dim arrStart,arrEnd,line, arrStrIntersectionPoint
         arrStart = arrBasePoint(j,k)'Array(arrBasePoint(j,k,0),arrBasePoint(j,k,1),0)
         arrEnd = Array(arrBasePoint(j,k)(0),arrBasePoint(j,k)(1),100)
         line = Rhino.AddLine (arrStart, arrEnd)
         
         arrStrIntersectionPoint = Rhino.CurveBrepIntersect (line, strBrep)
         
     
         '取得string identifier的坐标的数字
         '(此方法太复杂了，有谁能找到更好的方法，请email： )
         Dim strDump
         strDump = Rhino.ObjectDump(arrStrIntersectionPoint(0),1)

         Dim totallen
         totallen = Len(strDump)     
         Dim txt
         txt = Left(strDump,totallen-3)
         txt = Right(txt,totallen-26)
         
         Dim arrPoint

         arrPoint = Rhino.Str2Pt(txt)
         arrBasePoint(j,k)(2) = arrPoint(2)
         
         '删除line
         Rhino.DeleteObject (line)
         '删除point
         Rhino.DeleteObject (arrStrIntersectionPoint(0))
      Next
   Next
   
   '画图
   Dim l,m
   For l =0 To (row-1) Step 1
      For m=0 To (col-1) Step 1
         '底边上的逆时针的4个点是（l,m）（l+1,m）（l+1,m+1）（j,k+1）
         '画顶面
         Call DrawPanel(l, m,arrBasePoint)
                 
      Next
   Next
   
   Call Rhino.enableredraw(True)
   
End Sub

Public Function DrawPanel(l, m,ByVal arrBasePointInput)

   '底边上的逆时针的4个点是（l,m）（l+1,m）（l+1,m+1）（l,m+1）
   '顶面上，0，1，3点组成一个面
   '求出中心点的位置:arrCenterPoint
   Dim arrCenterPoint(2)
   
   arrCenterPoint(0)=(arrBasePointInput(l,m)(0)+arrBasePointInput(l+1,m+1)(0))/2
   arrCenterPoint(1)=(arrBasePointInput(l,m)(1)+arrBasePointInput(l+1,m+1)(1))/2
   arrCenterPoint(2)= (arrBasePointInput(l,m)(2)+arrBasePointInput(l+1,m)(2)+arrBasePointInput(l+1,m+1)(2)+arrBasePointInput(l,m+1)(2))/4 * hight_ratio
     
   Call DrawThicknessTriangle(arrBasePointInput(l,m), arrBasePointInput(l+1,m), arrBasePointInput(l,m+1), dbThickness)
   Call DrawThicknessTriangle(arrBasePointInput(l+1,m), arrBasePointInput(l+1,m+1), arrCenterPoint, dbThickness)
   Call DrawThicknessTriangle(arrBasePointInput(l+1,m+1), arrBasePointInput(l,m+1), arrCenterPoint, dbThickness)
   
   
End Function

Public Function DrawThicknessTriangle(arrPointA, arrPointB,arrPointC,thinckness)

   '   Dim arrVertices(2)
   '   arrVertices(0) = arrPointA
   '   arrVertices(1) = arrPointB
   '   arrVertices(2) = arrPointC
   '   Dim arrFaceVertices(0)
   '   arrFaceVertices(0) = Array(0,1,2,2)
   '   Rhino.AddMesh arrVertices, arrFaceVertices
   
   Dim arrPoints(2), strTriangleSurface,  arrPoint, arrParam, arrNormal, line
     
   arrpoints(0) = arrPointA
   arrpoints(1) = arrPointB
   arrpoints(2) = arrPointC

   If IsArray(arrPoints) Then

      strTriangleSurface = Rhino.AddSrfPt(arrPoints)

   End If
   
   Dim vectorBA, vectorCA, vectorCross,lengthVector
   vectorBA = Rhino.VectorCreate (arrPointB, arrPointA)
   vectorCA = Rhino.VectorCreate (arrPointC, arrPointA)
   vectorCross = Rhino.VectorCrossProduct(vectorBA, vectorCA)
   
   lengthVector = Rhino.VectorLength(vectorCross)
   
   vectorCross = Rhino.VectorReverse(vectorCross)
   vectorCross = Rhino.VectorScale(vectorCross, thinckness/lengthVector)
   
   line = Rhino.AddLine( Array(0,0,0), vectorCross)
   
   Rhino.ExtrudeSurface strTriangleSurface, line
   
   '   arrPoint = Rhino.GetPointOnSurface(strTriangleSurface)
'   rhino.Print("test1")
'   arrParam = Rhino.SurfaceClosestPoint(strTriangleSurface, arrPoint)
'   rhino.Print("test2")
'   arrNormal = Rhino.SurfaceNormal(strTriangleSurface, arrParam)
'   rhino.Print("test3")
'   line = Rhino.AddLine( Array(0,0,0), arrNormal)
   

   
End Function