Option Explicit
‘——————————————————————————-
‘ Subroutine: cheeweelook part 1
‘ Purpose: rotira tougao oko stranica + smanjuje trougao po tezishnoj duzi
‘ Author: Milutin Cerovic 2008
‘——————————————————————————–
Call Main()
Sub Main()
Dim i,j,Sf
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 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
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