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作者: yanhui314 时间: 2009-9-24 17:33
哪里哪里，我有VB.net的voronoi2D，但是没看懂，RS版的应该能看懂。作者: f(x) 时间: 2009-9-24 18:57
这个应该可以看懂了吧。作者: 射手明 时间: 2009-9-27 05:27 3#f(x)