Call Main()
Sub Main()
Const objecttype=8
Dim strsurface,strcrv1,strcrv2,udomain,vdomain,uparam,vparam,arrpoints,i,j,secu,secv
strsurface=rhino.GetObject("seslect surface",8)
strcrv1=rhino.GetObject("select crv1",4)
strcrv2=rhino.GetObject("select crv2",4)
Dim L
If isnull (strsurface) Then Exit Sub
secu=60
secv=60
ReDim collec(secu,secv)
udomain=rhino.SurfaceDomain(strsurface,0)
vdomain=rhino.SurfaceDomain(strsurface,1)
For i=0 To secu
For j=0 To secv
uparam=udomain(0)+i*((udomain(1)-udomain(0))/secu)
vparam=vdomain(0)+j*((vdomain(1)-vdomain(0))/secv)
arrpoints=rhino.EvaluateSurface(strsurface,array(uparam,vparam))
collec(i,j)=arrpoints
Next
Next
Dim npoint1,npoint2,npoint3,npoint4,npoint5,circle
Dim addnp1,addnp2,addnp3,addnp4,addnp5
Dim ap1,ap2,ap5,clospt1,dist1,clospt2,dist2,R,apcls1,apcls2,adcls1,adcls2
Dim ev1,ev2
For i=0 To secu -1 Step 4
For j=0 To secv -1 Step 3
If j Mod 2 = 0 Then
L=i+2
Else
L=i
End If
R = (dist1 + dist2)/40
rhino.Print(R)
If R < 2 Then
R = 2
ElseIf R > 10 Then
R = 10
End If
Dim arrplane
arrplane = rhino.PlaneFromPoints(ap5, ap1 ,ap2)
rhino.AddCircle arrplane, R
Next
Next
End Sub作者: wawxfcao 时间: 2012-7-1 14:23
是个双曲线影响的程序 第71行提示 type mismatch in parameter array required