Tìm kiếm Blog này

Thứ Năm, 26 tháng 8, 2010

dragon city statue competition- week 2

code  

dragon city statue competition- week 1

thức cột Trung quốc :




thức cột Việt Nam:
 tôi nhận thấy sự tương đồng của cột rồng của hai nước tuy nhiên cũng có những sự khác biệt giữa chúng về việc sử dụng màu sắc, họa tiêt trang trí. kỹ thuật .Tuy nhiên, với kiến thức hạn hẹp về lịch sử nếu muốn phân biệt hai loại cột này thì có lẽ  tôi cần thêm thời gian để tìm hiểu sâu hơn
Ý TƯỞNG THIẾT KẾ :

Thứ Năm, 19 tháng 8, 2010

Paper Art

http://www.youtube.com/watch?v=vYf5UqJa_O4&feature=player_embedded#!
 thật ngạc nhiên về sự sáng tạo của con người. Thật tuyệt vời! tôi không ngừng trầm trồ và tham phục đôi bàn tay khéo léo và bộ óc đầy sáng tạo của họ .Nó khơi dậy trong tôi một ý tưởng, tôi sẽ viết một đọan code để thự hiện việc này trên máy tính ( tôi không đc khéo tay cho lắm  =.=!).

Thứ Ba, 17 tháng 8, 2010

Lattice Pipe

Lattice Pipe


Option Explicit
'Script written by <David Mans>
'Script copyrighted by <NeoArchaic Studio>
'Script version Sunday, August 30, 2009 1:22:47 AM

Call Main()
Sub Main()
    Dim strCurve
    strCurve = Rhino.GetObject("Select Curve",4,True)
    If IsNull(strCurve) Then Exit Sub
    Call reparameterize(strCurve)
   
    Dim arrItems, arrValues, arrReturns
    arrItems = Array("Strands","Rotations","Strand Oscillations","Min Radius","Max Radius","Radius Oscillations","Samples")
    arrValues= Array(8,0,4,1,2,4,18)
    arrReturns = Rhino.PropertyListBox (arrItems, arrValues ,,"Parameters")
    If IsNull(arrReturns) Then Exit Sub
   
    Call Rhino.EnableRedraw(False)
    Call curveLattice(strCurve,CInt(arrReturns(0)),CInt(arrReturns(2)),CDbl(arrReturns(1)),Array(CDbl(arrReturns(3)),CDbl(arrReturns(4))),CInt(arrReturns(5)),CInt(arrReturns(6)))
    Call Rhino.EnableRedraw(True)
   
End Sub
Function curveLattice(strCurve,intStrands,intOscillations, dblRotation, arrRadius, intRadius, intSamples)
    curveLattice = Null
    intOscillations = intOscillations*2

    Dim i,j, count, tDom, tStep, rStep, dblSc
    Dim tFrame, rFrame
    Dim arrOutput(),arrPt()
   
    count = intSamples*intOscillations
    ReDim arrPt(count), arrOutput(intStrands)
   
    tDom = Rhino.CurveDomain(strCurve)
    tStep = (tDom(1)-tDom(0))/count
    rStep = 360/intStrands
    dblSc = arrRadius(1)-arrRadius(0)
   
    For i = 0 To intStrands-1 Step 1
        For j = 0 To count Step 1
            tFrame = Rhino.CurvePerpFrame(strCurve,tDom(0)+tStep*j)
            If i Mod(2) Then
                rFrame = Rhino.RotatePlane(tFrame,rStep*i+(rStep*0.5)*Sin(intOscillations*PI*(j/count))+(360*dblRotation)*j/count,tFrame(3))
            Else
                rFrame = Rhino.RotatePlane(tFrame,rStep*i+(rStep*0.5)*Sin(PI+intOscillations*PI*(j/count))+(360*dblRotation)*j/count,tFrame(3))
            End If
            arrPt(j) = Rhino.PointAdd(tFrame(0),Rhino.VectorScale(Rhino.VectorUnitize(rFrame(1)),arrRadius(0)+dblSc+dblSc*Cos(intRadius*PI*(j/count))))
        Next
        arrOutput(i) = arrPt
        Call Rhino.AddInterpCurve(arrPt)
    Next
   
    curveLattice = arrOutput
End Function
Function reparameterize(strObjectID)
    If Rhino.IsCurve(strObjectID) = True Then
        Call Rhino.SelectObject(strObjectID)
        Call Rhino.Command("reparameterize 0 1")
        Call Rhino.UnselectAllObjects()
    End If
    If Rhino.IsSurface(strObjectID) = True Then
        Call Rhino.SelectObject(strObjectID)
        Call Rhino.Command("reparameterize 0 1 0 1")
        Call Rhino.UnselectAllObjects()
    End If       
End Function

random points




Option Explicit
'Script written by <David Mans>
'Script copyrighted by <NeoArchaic Studio>
'Script version Friday, October 02, 2009 12:22:08 AM

Call Main()
Sub Main()
    Dim i, j, arrObjects, strType, strMethod, intCount, dblRadius, dblDim(2), arrCircles(), arrPoints()
   
    intCount = Rhino.GetInteger("Total Number of Points",100,1)
    If IsNull(intCount) Then Exit Sub
   
    strType = Rhino.GetString("Select Geometry Type","Circle",Array("Circle","Sphere","Cube","Curve","Surface"))
    If IsNull(strType) Then Exit Sub
   
    If strType = "Circle" Then
        strType = Rhino.GetString("Select Circle Geometry","Object",Array("Object","ByOrigin"))
        If IsNull(strType) Then Exit Sub
        strMethod = Rhino.GetString("Select Circle Method","Dispersed",Array("Dispersed","Radial"))
        If IsNull(strMethod) Then Exit Sub
       
        If strType = "Object" Then
            arrObjects = Rhino.GetObjects("Select Circles",4,,True)
            If IsNull(arrObjects) Then Exit Sub
            j=0
           
            For i = 0 To UBound(arrObjects) Step 1
                If Rhino.IsCircle(arrObjects(i)) Then
                    ReDim Preserve arrCircles(j), arrPoints(j)
                    arrCircles(j) = arrObjects(i)
                    arrPoints(j) = Rhino.CircleCenterPoint(arrCircles(j))
                    j = j+1
                End If
            Next
            arrObjects = arrPoints
        Else
            arrObjects = Rhino.GetObjects("Select Origin Points",1,,True)
            If IsNull(arrObjects) Then Exit Sub
            dblRadius = Rhino.GetReal("Radius",1)
            If IsNull(dblRadius) Then Exit Sub
        End If
        Call Rhino.EnableRedraw(False)
        For i = 0 To UBound(arrObjects) Step 1
            If strType = "Object" Then
                dblRadius = Rhino.CircleRadius(arrCircles(i))
            Else
                arrObjects(i) = Rhino.PointCoordinates(arrObjects(i))
            End If
            If strMethod = "Radial" Then
                Call Rhino.AddPointCloud(randomPointCircleRadial(arrObjects(i), dblRadius, intCount))
            Else
                Call Rhino.AddPointCloud(randomPointCircle(arrObjects(i), dblRadius, intCount))
            End If
        Next
        Call Rhino.EnableRedraw(True)
        Exit Sub
       
    ElseIf strType = "Sphere" Then
        strMethod = Rhino.GetString("Select Sphere Method","Volume",Array("Volume","Radial","Shell"))
        If IsNull(strMethod) Then Exit Sub
        arrObjects = Rhino.GetObjects("Select Origin Points",1,,True)
        If IsNull(arrObjects) Then Exit Sub
        dblRadius = Rhino.GetReal("Radius",1)
        If IsNull(dblRadius) Then Exit Sub
        Call Rhino.EnableRedraw(False)
        For i = 0 To UBound(arrObjects) Step 1
            If strMethod = "Volume" Then
                Call Rhino.AddPointCloud(randomPointSphere(Rhino.PointCoordinates(arrObjects(i)), dblRadius, intCount))
            ElseIf strMethod = "Shell" Then
                Call Rhino.AddPointCloud(randomPointSphereShell(Rhino.PointCoordinates(arrObjects(i)), dblRadius, intCount))
            Else
                Call Rhino.AddPointCloud(randomPointSphereVol(Rhino.PointCoordinates(arrObjects(i)), dblRadius, intCount))
            End If
        Next       
        Call Rhino.EnableRedraw(True)
        Exit Sub
       
    ElseIf strType = "Cube" Then
        strMethod = Rhino.GetString("Select Cube Method","Volume",Array("Volume","Shell"))
        If IsNull(strMethod) Then Exit Sub
        arrObjects = Rhino.GetObjects("Select Origin Points",1,,True)
        If IsNull(arrObjects) Then Exit Sub
        dblDim(0) = Rhino.GetReal("Length",1)
        dblDim(1) = Rhino.GetReal("Width",1)
        dblDim(2) = Rhino.GetReal("Height",1)
        Call Rhino.EnableRedraw(False)
        For i = 0 To UBound(arrObjects) Step 1
            If strMethod = "Volume" Then
                Call Rhino.AddPointCloud(randomPointCubeVol(Rhino.PointCoordinates(arrObjects(i)), dblDim(0), dblDim(1), dblDim(2), intCount))
            Else
                Call Rhino.AddPointCloud(randomPointCube(Rhino.PointCoordinates(arrObjects(i)), dblDim(0), dblDim(1), dblDim(2), intCount))
            End If
        Next
        Call Rhino.EnableRedraw(True)
        Exit Sub
       
    ElseIf strType = "Curve" Then
        arrObjects = Rhino.GetObjects("Select Curves",4,,True)
        If IsNull(arrObjects) Then Exit Sub
        dblRadius = Rhino.GetReal("Maximum Deviation",1)
        If IsNull(dblRadius) Then Exit Sub
        Call Rhino.EnableRedraw(False)
        For i = 0 To UBound(arrObjects) Step 1
            Call reparameterize(arrObjects(i))
            Call Rhino.AddPointCloud(randomPtsCrv(arrObjects(i),dblRadius,intCount))
        Next
        Call Rhino.EnableRedraw(True)
        Exit Sub
       
    ElseIf strType = "Surface" Then
        arrObjects = Rhino.GetObjects("Select Surfaces",8,,True)
        If IsNull(arrObjects) Then Exit Sub
        dblRadius = Rhino.GetReal("Maximum Deviation",1)
        If IsNull(dblRadius) Then Exit Sub
        Call Rhino.EnableRedraw(False)
        For i = 0 To UBound(arrObjects) Step 1
            Call reparameterize(arrObjects(i))
            Call Rhino.AddPointCloud(randomPtsSrf(arrObjects(i),dblRadius,intCount))
        Next
        Call Rhino.EnableRedraw(True)
        Exit Sub
    End If
       
End Sub
Function randomPointCircleRadial(arrOrigin, dblRadius, intCount)
    randomPointCircleRadial = Null
    Dim i, dblRandom(1), arrOutput()
    ReDim arrOutput(intCount-1)
   
    For i = 0 To intCount-1 Step 1
        dblRandom(0) = random(0,2*PI)
        dblRandom(1) = random(0,dblRadius)
        arrOutput(i) = Array(arrOrigin(0)+dblRandom(1)*Sin(dblRandom(0)),arrOrigin(1)+dblRandom(1)*Cos(dblRandom(0)),arrOrigin(2))
    Next
    randomPointCircleRadial = arrOutput
End Function
Function randomPointCircle(arrOrigin, dblRadius, intCount)
    randomPointCircle = Null
    Dim i, arrOutput()
    ReDim arrOutput(intCount-1)
   
    For i = 0 To intCount-1 Step 1
        Do
            arrOutput(i) = Array(arrOrigin(0)+random(-dblRadius,dblRadius),arrOrigin(1)+random(-dblRadius,dblRadius),arrOrigin(2))
           
            If Rhino.Distance(arrOrigin,arrOutput(i)) < dblRadius Then Exit Do
        Loop
    Next
    randomPointCircle = arrOutput
End Function
Function randomPointSphereShell(arrOrigin, dblRadius, intCount)
    randomPointSphereShell = Null
    Dim i, dblRandom(1), arrOutput()
    ReDim arrOutput(intCount-1)
   
    For i = 0 To intCount-1 Step 1
        dblRandom(0) = random(0,2*PI)
        dblRandom(1) = random(0,PI)
        arrOutput(i) = Array(arrOrigin(0)+dblRadius*Sin(dblRandom(0))*Sin(dblRandom(1)),arrOrigin(1)+dblRadius*Cos(dblRandom(0))*Sin(dblRandom(1)),arrOrigin(2)+dblRadius*Cos(dblRandom(1)))
    Next
    randomPointSphereShell = arrOutput
End Function
Function randomPointSphere(arrOrigin, dblRadius, intCount)
    randomPointSphere = Null
    Dim i, arrOutput()
    ReDim arrOutput(intCount-1)
   
    For i = 0 To intCount-1 Step 1
        Do
            arrOutput(i) = Array(arrOrigin(0)+random(-dblRadius,dblRadius),arrOrigin(1)+random(-dblRadius,dblRadius),arrOrigin(2)+random(-dblRadius,dblRadius))
            If Rhino.Distance(arrOrigin,arrOutput(i)) < dblRadius Then Exit Do
        Loop
    Next
    randomPointSphere = arrOutput
End Function
Function randomPointSphereVol(arrOrigin, dblRadius, intCount)
    randomPointSphereVol = Null
    Dim i, dblRandom(2), arrOutput()
    ReDim arrOutput(intCount-1)
   
    For i = 0 To intCount-1 Step 1
        dblRandom(0) = random(0,2*PI)
        dblRandom(1) = random(0,PI)
        dblRandom(2) = random(0,dblRadius)
        arrOutput(i) = Array(arrOrigin(0)+dblRandom(2)*Sin(dblRandom(0))*Sin(dblRandom(1)),arrOrigin(1)+dblRandom(2)*Cos(dblRandom(0))*Sin(dblRandom(1)),arrOrigin(2)+dblRandom(2)*Cos(dblRandom(1)))
    Next
    randomPointSphereVol = arrOutput
End Function
Function randomPointCube(arrOrigin, dblLength, dblWidth, dblHeight, intCount)
    randomPointCube = Null
    Dim i, arrOutput()
    ReDim arrOutput(intCount-1)
   
    For i = 0 To intCount-1 Step 1
        arrOutput(i) = Array(arrOrigin(0)+random(0,dblLength),arrOrigin(1)+random(0,dblLength),arrOrigin(2)+random(0,dblHeight))
    Next
    randomPointCube = arrOutput
End Function
Function randomPointCubeVol(arrOrigin, dblLength, dblWidth, dblHeight, intCount)
    randomPointCubeVol = Null
    Dim i, arrOutput()
    ReDim arrOutput(intCount-1)
   
    For i = 0 To intCount-1 Step 1
        arrOutput(i) = Array(arrOrigin(0)+random(0,dblLength),arrOrigin(1)+random(0,dblLength),arrOrigin(2)+random(0,dblHeight))
    Next
    randomPointCubeVol = arrOutput
End Function
Function randomPtsCrv(strCurve,dblDist,intCount)
    randomPtsCrv = Null
    Dim i, tDom, dblRandom, arrOutput()
    ReDim arrOutput(intCount-1)
    tDom = Rhino.CurveDomain(strCurve)
   
    For i = 0 To intCount-1 Step 1
        dblRandom = random(tDom(0),tDom(1)-tDom(0))
        arrOutput(i) = Rhino.PointAdd(Rhino.EvaluateCurve(strCurve,dblRandom),Rhino.VectorScale(Rhino.VectorUnitize(Rhino.CurvePerpFrame(strCurve,dblRandom)(1)),random(-dblDist,dblDist)))
    Next

    randomPtsCrv = arrOutput
End Function
Function randomPtsSrf(strSurface,dblDist,intCount)
    randomPtsSrf = Null
    Dim i, uDom, vDom, arrOutput()
    ReDim arrOutput(intCount-1)
    uDom = Rhino.SurfaceDomain(strSurface,0)
    vDom = Rhino.SurfaceDomain(strSurface,1)
   
    For i = 0 To intCount-1 Step 1
        arrOutput(i) = Rhino.PointAdd(Rhino.EvaluateSurface(strSurface,Array(random(uDom(0),uDom(1)),random(vDom(0),vDom(1)))),Rhino.VectorScale(Rhino.VectorUnitize(Rhino.SurfaceNormal(strSurface,Array(random(uDom(0),uDom(1)),random(vDom(0),vDom(1))))),random(-dblDist,dblDist)))
    Next

    randomPtsSrf = arrOutput
End Function
Function random(min,max)
    random = Null
    Dim dblValue: dblValue = min+(max-min)*Rnd()
    random = dblValue
End Function
Function reparameterize(strObjectID)
    If Rhino.IsCurve(strObjectID) = True Then
        Call Rhino.SelectObject(strObjectID)
        Call Rhino.Command("reparameterize 0 1",False)
        Call Rhino.UnselectAllObjects()
    End If
    If Rhino.IsSurface(strObjectID) = True Then
        Call Rhino.SelectObject(strObjectID)
        Call Rhino.Command("reparameterize 0 1 0 1",False)
        Call Rhino.UnselectAllObjects()
    End If
End Function

Weave A

 




Option Explicit
'Script written by <David Mans>
'Script copyrighted by <Neoarchaic Design>
'Script version Saturday, October 04, 2008 7:52:05 PM

Call Main()
Sub Main()
    Dim surface, weave, arrItems, arrValues, arrResults
   
    surface = Rhino.GetObject("Select Surface",8)
    If isNull(surface) Then Exit Sub
    Call reparameterize(surface)
   
    arrItems = array("Warp Strands","Weft Strands","Depth")
    arrValues = array(10,10,0.5)
    arrResults = Rhino.PropertyListBox (arrItems, arrValues ,,"Weave Settings")
    If isNull(arrResults) Then Exit Sub
   
    Call Rhino.EnableRedraw(False)
    weave = crossWeave(surface,CDbl(arrResults(0)),CDbl(arrResults(1)),CDbl(arrResults(2)))
    Call Rhino.EnableRedraw(True)
   
End Sub
Function crossWeave(surface,cols,rows,depth)
    crossWeave = Null
    cols = cols*2
    rows = rows*2
    Dim i, j, r, s, count, uDom, vDom, origin, srfNorm,crvCount
    crvCount = cols*0.5+rows*0.5-1
    Dim boolVal(), blnVal(), normal(1),norm(),nrm(),crvs(),xcrvs()
    ReDim boolVal(rows), blnVal(cols)
    ReDim norm(rows),nrm(cols),crvs(crvCount),xcrvs(crvCount)
    uDom = Rhino.SurfaceDomain(surface,0)(1)
    vDom = Rhino.SurfaceDomain(surface,1)(1)
   
    For i = 0 To cols Step 1
        For j = 0 To rows Step 1
            boolVal(j) = array(0,1)
            origin = array(uDom/(cols)*i,vDom/(rows)*j)
            srfNorm = Rhino.VectorScale(Rhino.VectorUnitize(Rhino.SurfaceNormal(surface,origin)),depth)
           
            normal(0) = Rhino.PointAdd(Rhino.EvaluateSurface(surface,origin),srfNorm)
            normal(1) = Rhino.PointAdd(Rhino.EvaluateSurface(surface,origin),Rhino.VectorReverse(srfNorm))
            norm(j) = normal
           
        Next
        blnVal(i) = boolVal
        nrm(i) = norm
    Next
   
    Dim ptA(),ptB(),ptC(),ptD()
    If cols>rows Then
        count = cols
    Else
        count = rows
    End If
   
    s=0
    For i = 1 To count Step 1
        r=0
        ReDim ptA(0), ptB(0)
        If i Mod(2) Then
            If cols > rows Then
                If i < rows Then
                    For j = 0 To i Step 1
                        ReDim Preserve ptA(r)
                        blnVal(j)(i-j) = flipMe(r+1)
                        ptA(r) = nrm(j)(i-j)(blnVal(j)(i-j)(0))
                        r=r+1
                    Next
                    crvs(s) = Rhino.AddInterpCurve(ptA)
                    r=0
                    For j = 0 To rows-i Step 1
                        ReDim Preserve ptB(r)
                        blnVal(cols-rows+i+j)(rows-j) = flipMe(r)
                        ptB(r) = nrm(cols-rows+i+j)(rows-j)(blnVal(cols-rows+i+j)(rows-j)(0))
                        r=r+1
                    Next
                    crvs(cols*0.5+s) = Rhino.AddInterpCurve(ptB)
                    s=s+1
                Else
                    For j = 0 To rows Step 1
                        ReDim Preserve ptA(r)
                        blnVal(i-rows+j)(rows-j) = flipMe(r)
                        ptA(r) = nrm(i-rows+j)(rows-j)(blnVal(i-rows+j)(rows-j)(0))
                        r=r+1
                    Next
                    crvs(s) = Rhino.AddInterpCurve(ptA)
                    s=s+1
                End If
            ElseIf rows > cols Then
                If i < cols Then
                    For j = 0 To i Step 1
                        ReDim Preserve ptA(r)
                        blnVal(j)(i-j) = flipMe(r)
                        ptA(r) = nrm(j)(i-j)(blnVal(j)(i-j)(0))
                        r=r+1
                    Next
                    crvs(s) = Rhino.AddInterpCurve(ptA)
                    r=0
                    For j = 0 To cols-i Step 1
                        ReDim Preserve ptB(r)
                        blnVal(i+j)(rows-j) = flipMe(r+1)
                        ptB(r) = nrm(i+j)(rows-j)(blnVal(i+j)(rows-j)(0))
                        r=r+1
                    Next
                    crvs(rows*0.5+s) = Rhino.AddInterpCurve(ptB)
                    s=s+1
                Else
                    For j = 0 To cols Step 1
                        ReDim Preserve ptA(r)
                        blnVal(j)(i-j) = flipMe(r)
                        ptA(r) = nrm(j)(i-j)(blnVal(j)(i-j)(0))
                        r=r+1
                    Next
                    crvs(s) = Rhino.AddInterpCurve(ptA)
                    s=s+1
                End If
            Else
                'If they are equal
                For j = 0 To i Step 1
                    ReDim Preserve ptA(r)
                    blnVal(j)(i-j) = flipMe(r)
                    ptA(r) = nrm(j)(i-j)(blnVal(j)(i-j)(0))
                    r=r+1
                Next
                r=0
                For j = 0 To cols-i Step 1
                    ReDim Preserve  ptB(r)
                    blnVal(i+j)(cols-j) = flipMe(r+1)
                    ptB(r) = nrm(i+j)(cols-j)(blnVal(i+j)(cols-j)(0))
                    r=r+1
                Next
                crvs(s) = Rhino.AddInterpCurve(ptA)
                crvs(cols*0.5+s) = Rhino.AddInterpCurve(ptB)
                s=s+1
            End If
        End If
    Next
   
    s=0
    For i = 1 To count Step 1
        r=0
        ReDim ptC(0), ptD(0)
        If i Mod(2) Then
            If cols > rows Then
                If i < rows Then
                    For j = 0 To i Step 1
                        ReDim Preserve ptC(r), ptD(r)
                        ptC(r) = nrm(cols-i+j)(j)(blnVal(cols-i+j)(j)(1))
                        ptD(r) = nrm(j)(rows-i+j)(blnVal(j)(rows-i+j)(1))
                        r=r+1
                    Next
                    xcrvs(s) = Rhino.AddInterpCurve(ptD)
                    s=s+1
                    xcrvs(cols*0.5+rows*0.5-s) = Rhino.AddInterpCurve(ptC)
                Else
                    r=0
                    For j = 0 To rows Step 1
                        ReDim Preserve ptC(r)
                        ptC(r) = nrm(i-rows+j)(j)(blnVal(i-rows+j)(j)(1))
                        r=r+1
                    Next
                    xcrvs(s) = Rhino.AddInterpCurve(ptC)
                    s=s+1
                End If
            ElseIf rows > cols Then
                If i < cols Then
                    For j = 0 To i Step 1
                        ReDim Preserve ptC(r), ptD(r)
                        ptC(r) = nrm(cols-i+j)(j)(blnVal(cols-i+j)(j)(1))
                        ptD(r) = nrm(j)(rows-i+j)(blnVal(j)(rows-i+j)(1))
                        r=r+1
                    Next
                    xcrvs(s) = Rhino.AddInterpCurve(ptD)
                    s=s+1
                    xcrvs(cols*0.5+rows*0.5-s) = Rhino.AddInterpCurve(ptC)
                Else
                    r=0
                    For j = 0 To cols Step 1
                        ReDim Preserve ptC(r)
                        ptC(r) = nrm(j)(i-cols+j)(blnVal(j)(i-cols+j)(1))
                        r=r+1
                    Next
                    s=s+1
                    xcrvs(rows*0.5+cols*0.5-s) = Rhino.AddInterpCurve(ptC)
                End If
            Else
                For j = 0 To i Step 1
                    ReDim Preserve ptC(r),ptD(r)
                    ptC(r) = nrm(cols-i+j)(j)(blnVal(cols-i+j)(j)(1))
                    ptD(r) = nrm(j)(rows-i+j)(blnVal(j)(rows-i+j)(1))
                    r=r+1
                Next
                xcrvs(cols-1-s) = Rhino.AddInterpCurve(ptC)
                xcrvs(s) = Rhino.AddInterpCurve(ptD)
                s=s+1
            End If
        End If
    Next
   
    crossWeave = array()
End Function
Function reparameterize(strCurveID)
    If Rhino.IsCurve(strCurveID) = True Then
        Call rhino.SelectObject(strCurveID)
        Call rhino.Command("reparameterize 0 1")
        Call rhino.UnselectAllObjects()
    End If
    If Rhino.IsSurface(strCurveID) = True Then
        Call rhino.SelectObject(strCurveID)
        Call rhino.Command("reparameterize 0 1 0 1")
        Call rhino.UnselectAllObjects()
    End If
End Function
Function flipMe(input)
    flipMe = Null
    Dim output(1)
    If input Mod(2) Then
        output(0) = 0
        output(1) = 1
    Else
        output(0) = 1
        output(1) = 0
    End If
    flipMe = output
End Function

Weave B










Option Explicit
'Script written by <David Mans>
'Script copyrighted by <Neoarchaic Design>
'Script version Friday, September 12, 2008 6:05:11 PM

Call Main()
Sub Main()
    Dim surface, arrItems, arrValues, arrResults, rhythmA,rhythmB
    surface = Rhino.GetObject("Select Surface",8)
    If isNull(surface) Then Exit Sub
   
    arrItems = array("Warp Strands","Weft Strands","Depth","Warp Rhythm(up,down...)","Warp Rhythm(up,down...)")
    arrValues = array(10,10,1,"2,3,2","2,3,2")
    arrResults = Rhino.PropertyListBox (arrItems, arrValues ,,"Weave Settings")
   
    rhythmA = split(arrResults(3),",")
    rhythmB = split(arrResults(4),",")
   
    Call Rhino.EnableRedraw(False)
    Call reparameterize(surface)
    Call weave(surface,CDbl(arrResults(0)),CDbl(arrResults(1)),CDbl(arrResults(2)),rhythmA,rhythmB)
    Call Rhino.EnableRedraw(True)
   
   
End Sub
Function weave(surface,cols,rows,scale,rhythmA,rhythmB)
    weave = Null
   
    Dim i,j,r,s,t,u,v
    Dim uDom, vDom
    Dim pts(), ptsX(1), pt()
    ReDim pts(rows),pt(cols)
   
    uDom = Rhino.SurfaceDomain(surface,0)(1)
    vDom = Rhino.SurfaceDomain(surface,1)(1)
    For i = 0 To cols Step 1
        For j = 0 To rows Step 1
            ptsX(0) = Rhino.PointAdd(Rhino.EvaluateSurface(surface,array((uDom/cols)*i,(vDom/rows)*j)),Rhino.VectorScale(Rhino.VectorUnitize(Rhino.SurfaceNormal(surface,array((uDom/cols)*i,(vDom/rows)*j))),scale))
            ptsX(1) = Rhino.PointAdd(Rhino.EvaluateSurface(surface,array((uDom/cols)*i,(vDom/rows)*j)),Rhino.VectorScale(Rhino.VectorUnitize(Rhino.VectorReverse(Rhino.SurfaceNormal(surface,array((uDom/cols)*i,(vDom/rows)*j)))),scale))
            pts(j) = ptsX
        Next
        pt(i) = pts
    Next
   
    Dim a,b
    Dim inverse(),inv(),pointSetA(),pointSetB()
    ReDim inverse(rows),inv(cols),pointSetA(rows),pointSetB(cols)
   
    Dim arrBln(), blnSt
    ReDim arrBln(cols)
   
    u=0
    t=rhythmA(0)
    For i = 0 To cols Step 1
        If u Mod(2) Then
            v=0
        Else
            v=1
        End If
        r=rhythmB(0)
        For j = 0 To rows Step 1
            If v Mod(2) Then
                a = 0: b = 1
            Else
                a = 1: b = 0
            End If
            r=r-1
            If r = 0 Then
                r=rhythmB(s)
                v=v+1
            End If
            If s>uBound(rhythmB)Then
                v=0
            End If
           
            pointSetA(j) = pt(i)(j)(a)
            inverse(j) = b
        Next
        t=t-1
        If t = 0 Then
            t=rhythmA(u)
            u=u+1
           
        End If
        If u>uBound(rhythmA)Then
            u=0
        End If
        inv(i) = inverse
        blnSt = False
        r=0
        For j = 0 To rows Step 1
            r = r+inverse(j)
        Next
        If r = 0 Or r = rows-1 Then
        Else
            Call Rhino.addcurve(pointSetA,3)
        End If
    Next
   
    For i = 0 To rows Step 1
        r=0
        For j = 0 To cols Step 1
            r = r+inv(j)(i)
        Next
       
        For j = 0 To cols Step 1
            pointSetB(j) = pt(j)(i)(inv(j)(i))
        Next
        If r = 0 Or r = cols-1 Then
        Else
            Call Rhino.addcurve(pointSetB,3)
        End If
    Next
End Function
Function reparameterize(strCurveID)
    If Rhino.IsCurve(strCurveID) = True Then
        Call rhino.SelectObject(strCurveID)
        Call rhino.Command("reparameterize 0 1")
        Call rhino.UnselectAllObjects()
    End If
    If Rhino.IsSurface(strCurveID) = True Then
        Call rhino.SelectObject(strCurveID)
        Call rhino.Command("reparameterize 0 1 0 1")
        Call rhino.UnselectAllObjects()
    End If
End Function

Người theo dõi