http://www.archgo.com/bbs/viewtopic.php?f=1&t=12

2009-06-14

Option Explicit

'Script written by

'Script copyrighted by

'Script version 2009年6月13日 20:06:32

Call Main()

Sub Main()

Const site_width = 12

Const site_longth = 18

Const site_height = 15

Call rhino.enableRedraw(False)

'青年公寓的数量

Dim howManyYoungUnits : howManyYoungUnits = 750

'老年公寓的数量

Dim howManyOldUnits : howManyOldUnits = 375

'leader的位置

Dim howManyLeaders : howManyLeaders = 20

'首先，地块的三维数组

Dim arrSiteUnitStatus( 12, 18, 15)

Dim arrSiteSpaceStatus( 12, 18, 15)

Dim arrSiteUnitObjectID( 12, 18, 15)

'初始化随机数

Randomize

'每一层都随机分布

Dim i,j,k,l

'array使用前要初始化

For i =0 To site_width Step 1

For j = 0 To site_longth Step 1

For k = 0 To site_height Step 1

arrSiteUnitStatus(i,j,k)=0

arrSiteUnitObjectID(i,j,k)=0

arrSiteSpaceStatus(i,j,k)=0

Next

Next

Next

'初始化青年公寓，赋予随机的位置和固定的颜色

i = howManyYoungUnits

Do While i>0

j= Int((12 * Rnd))

k= Int((18 * Rnd))

l = Int((15 * Rnd))

If arrSiteUnitStatus(j,k,l)= 0 Then

arrSiteUnitObjectID(j,k,l) = 1

arrSiteUnitObjectID(j,k,l) = drawCube(j,k ,l)

i = i-1

End If

Loop

'初始化青年公寓，赋予随机的位置和固定的颜色

i = howManyOldUnits

Do While i>0

j= Int((12 * Rnd))

k= Int((18 * Rnd))

l = Int((15 * Rnd))

If arrSiteUnitStatus(j,k,l)= 0 Then

arrSiteUnitObjectID(j,k,l) = 2

arrSiteUnitObjectID(j,k,l) = drawCube(j,k ,l)

i = i-1

End If

Loop

'初始化“空间形态矩阵”产生leader

i = howManyLeaders

Do While i>0

j= Int((12 * Rnd))

k= Int((18 * Rnd))

l = Int((15 * Rnd))

If arrSiteSpaceStatus(j,k,l)= 0 Then

arrSiteSpaceStatus(j,k,l) = 1

i = i-1

End If

Loop

'检查空间的横向和纵向，是不是leader已经积聚，如果积聚，把空间的标记为可停留的、不可停留的

'检查行

'Const site_width = 12

'Const site_longth = 18

'Const site_height = 15

For i =0 To site_longth Step 1

l =0

Dim downLeftX, downLeftY, upRightX,upRightY

For j = 0 To site_width Step 1

For k = 0 To site_height Step 1

If arrSiteSpaceStatus(j,i,k)= 1 Then

'如果是第一个点，把所有的值都给它

If l =1 Then

downLeftX = j

downLeftY = k

upRightX = j

upRightY = k

End If

'记录" 左上"和“右下”的位置

If j

downLeftX =j

End If

If k

downLeftY =k

End If

If j>upRightX Then

upRightX =j

End If

If k>upRightY Then

upRightY =k

End If

'累加

l = l + 1

End If

Next

Next

'如果leader超过了3个，把这个区域变成固定区域

If l>2 Then

'该区域标记为固定区域

For j = 0 To site_width Step 1

For k = 0 To site_height Step 1

Next

Next

End If

Next

'绘图单元,遍历三维矩阵，绘制出每一个

Dim arrCenter

For i =0 To site_width Step 1

For j = 0 To site_longth Step 1

For k = 0 To site_height Step 1

'arrCenter = array(i*3,j*3,k*3)

'Rhino.AddSphere arrCenter, 3

'Call drawCube(i,j,k)

Next

Next

Next

Call rhino.enableRedraw(True)

End Sub

' 绘图单元,遍历三维矩阵，绘制出每一个

Function drawCube(x,y ,z)

Dim arr1,arr2,arr3 ,arr4,arr5,arr6,arr7,arr8,arrCorners

arr1 = array(x*7,y*7 ,z*3)

arr2 = array(x*7+7,y*7 ,z*3)

arr3 = array(x*7+7,y*7+7 ,z*3)

arr4 = array(x*7,y*7+7 ,z*3)

arr5 = array(x*7,y*7 ,z*3+3)

arr6 = array(x*7+7,y*7 ,z*3+3)

arr7 = array(x*7+7,y*7+7 ,z*3+3)

arr8 = array(x*7,y*7+7 ,z*3+3)

arrCorners=array(arr1,arr2,arr3 ,arr4,arr5,arr6,arr7,arr8)

Rhino.AddBox (arrCorners)

End Function