0708 [WS] MC rhinoscript studija

Option Explicit

'-------------------------------------------------------------------------------

' Subroutine: cheeweelook part 1

' Purpose: rotira tougao oko stranica + smanjuje trougao po tezishnoj duzi

' Author: Milutin Cerovic 2008

' www.4ofseven.com

'--------------------------------------------------------------------------------

Call Main()

Sub Main()
Dim i,j,Sf

Dim arrtemena1,arrTemp,arrNovoTeme,arraxis,arrSrfBochno(2)

Dim strTrougao

' input --------------------------------------------------------------------------

strTrougao = Rhino.GetObject("selektuj polyline trougao")

arrtemena1 = Rhino.PolyLineVertices(strTrougao)
For i = 1 To 8 ' broj krugova

For j = 0 To 2 ' loop kroz stranice trougla

' rotacija trougla + dodavanje povrshine ----------------------------------

arrtemena1 = Rhino.PolyLineVertices(strTrougao)

Rhino.AddSrfPt arrtemena1

arrtemena1 = duplicateArr(arrtemena1)

arrTemp = arrtemena1

arraxis = Rhino.VectorCreate(arrtemena1(j),arrtemena1(j+1)) ' osa rotacije

strTrougao = Rhino.RotateObject(strTrougao,arrtemena1(j),-30,arraxis,vbTrue)

' 0.scale trougla po tezishtu ---------------------------------------------------

arrtemena1 = Rhino.PolyLineVertices(strTrougao)

arrtemena1 = duplicateArr(arrtemena1)

arrNovoTeme = scaleTrougao(arrtemena1(j),arrtemena1(j+1),arrtemena1(j+2),3)

Rhino.EnableObjectGrips strTrougao
If j = 0 Then

Rhino.ObjectGripLocation strTrougao,2,arrNovoTeme

Else

If j = 1 Then

Rhino.ObjectGripLocation strTrougao,0,arrNovoTeme

Else

Rhino.ObjectGripLocation strTrougao,1,arrNovoTeme

End If

End If

Rhino.EnableObjectGrips strTrougao,False

' dodavanje bochne povrsine -----------------------------------------------------

arrtemena1 = Rhino.PolyLineVertices(strTrougao)

arrtemena1 = duplicateArr(arrtemena1)

arrSrfBochno(0) = arrTemp(j+2)

arrSrfBochno(1) = arrTemp(j)

arrSrfBochno(2) = arrtemena1(j+2)

Rhino.AddSrfPt arrSrfBochno

Next

Next

End Sub

Function scaleTrougao(arrT1,arrT2,arrT3,Sf)

Dim i

Dim strLajna

Dim arrMidP

strLajna = Rhino.AddLine(arrT1,arrT2)

arrMidP = Rhino.CurveMidPoint(strLajna)

For i = 1 To Sf ' tezishna duz, scale faktor

strLajna = Rhino.AddLine(arrT3,arrMidP)

arrMidP = Rhino.CurveMidPoint(strLajna)

Rhino.DeleteObject strLajna

Next

scaleTrougao = arrMidP

End Function

Function duplicateArr(arr)

Dim NewArr(6)

NewArr(0)=arr(0)

NewArr(1)=arr(1)

NewArr(2)=arr(2)

NewArr(3)=arr(0)

NewArr(4)=arr(1)

NewArr(5)=arr(2)

duplicateArr = Newarr

End Function