voronoi 2D 脚本

f(x)

刚刚看贴子的时候发现，以前答应给yanhui兄发voronoi　2D的脚本，一直都忘了，现在发出来， yanhui兄不会怪罪我吧。

Call Main()
Sub Main()
Dim aa,i
Dim arrBox,box2
aa=rhino.getobjects("point",1)

For i=0 To ubound(aa)
  arrBox=creatbox(aa,aa(i))
  box2=intersectbox(arrBox)
  
Next
End Sub
Function creatbox(points,cen)
Dim po,v1,v2,v3,vv,ce
Dim ps(4)
Dim v11,v22,v33
Dim i,j
Dim pts,mid,length
Dim cbox
length=10
vv=array(0,0,1)
ReDim cbox(Ubound(points))
enableredraw(False)
For i = 0 To UBound(points)
  pts= Rhino.PointCoordinates(Points(i))
  ce=rhino.PointCoordinates(cen)
  If Not rhino.isvectorzero(rhino.VectorSubtract(pts,ce)) Then
   mid=midp(ce,pts)
   v1=rhino.vectorunitize(rhino.VectorCreate(ce,mid))
   v2=rhino.vectorunitize(rhino.vectorcrossproduct(v1,vv))
   v3=rhino.vectorunitize(rhino.VectorReverse(v2))
  v11=rhino.VectorScale(v1,2*length)
   v22=rhino.VectorScale(v2,length)
   v33=rhino.VectorScale(v3,length)
  ps(0)=rhino.VectorAdd(mid,v22)
  ps(1)=rhino.VectorAdd(mid,v33)
   ps(2)=rhino.vectoradd(ps(1),v11)
   ps(3)=rhino.VectorAdd(ps(0),v11)
   ps(4)=rhino.VectorAdd(mid,v22)
   '检验xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
   'rhino.AddPoint(ps(0))
   'rhino.AddPoint(ps(1))
   'rhino.AddPoint(ps(2))
   'rhino.AddPoint(ps(3))
   'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
   cbox(i)=rhino.Addcurve(ps,2)
  End If
Next
enableredraw(True)
creatbox=deletenull(cbox)
End Function
Function intersectbox(bb)
intersectbox=Null
Dim i,qq,j
Dim aa
ReDim aa(ubound(bb))
aa(0)=bb(0)
enableredraw(False)
For i=1 To ubound(bb)
  qq=rhino.curveBooleanIntersection(bb(i),aa(i-1))
  If isarray(qq) Then
   If i=1 Then Rhino.DeleteObject bb(i-1)
   Rhino.DeleteObject bb(i)
   For j=1 To ubound(qq)
    rhino.DeleteObject(qq(j))
  Next
   aa(i)=qq(0)
   rhino.DeleteObject(aa(i-1))
  Else
   Rhino.DeleteObject bb(i)
   aa(i)=aa(i-1)
  End If
Next
enableredraw(True)
intersectbox=bb(0)
End Function   
Function midp(p1,p2)
midp=Null
midp=Array((p1(0)+p2(0))/2,(p1(1)+p2(1))/2,(p1(2)+p2(2))/2)
End Function
Function deletenull(list)
deletenull=Null
Dim i,j,n,m
n=Ubound(list)
For i=0 To n
  If isempty(list(i))=True Then m=i  
Next
For j=m To n-1
  list(j)=list(j+1)
Next
ReDim Preserve list(n-1)
deletenull=list
End Function

Tony

学习~~~~~~~~~~~

baroque2011

lz  我好葱白你哦.....

wawa

very good!!!!!

lightoo

楼主太强大了

yingboy

樓主很強大。。向你好好學習。。。

blade007

这个是RS的？？楼主很强大呀/。。。

huangchang0528

楼主真不错~~~~~~~~

ccocean

好像跟那个经典有点差距啊

angelliu321

顶 学学！！！！！

morphcode

thanks~~~~~

qiqiyunyan

一看这么多就烦啊。要是我写出来的也许就不会了吧，呵呵

wanghan06

的确有比较严重的bug啊~

df13

好像挺不賴的

panhao1

现在不是有不少人会rvb了么
这个脚本是我半年前写的 里面有很严重的bug
要想消除很简单
在
For i=0 To ubound(aa)
  arrBox=creatbox(aa,aa(i))
之间加个距离的排序（升序哦）就可以了
重排一下数组就行了

其实这个算法是仿照3d voronoi来的 并不太好 算得慢死了
好的算法《计算几何》里有 没必要认为这就是2dvoronoi的标准算法

panhao1

4# 射手明
我的代码风格都没看出来
我不是把北京写得代码都考给你了么 都不看下 哎~~~~

skywoolf

5# yjj8927367

我也很期待啊，可惜这种东西不太好弄到……

yjj8927367

{:3_57:}多有一些更有意义的脚本就好了，呵呵~

射手明

3# f(x)

很不错嘛，这个脚本是你写的吗？

f(x)

这个应该可以看懂了吧。

yanhui314

哪里哪里，我有VB.net的voronoi2D，但是没看懂，RS版的应该能看懂。