Convert2pts "1",.33,"1" 'user defined or input from context
Function Convert2pts(strType,UAmount,blnBitmap)
Dim TarPts,tarCrvs,tarsrfs,tarPlsfs,NumPts,temp(2),each_point_percent
'+++++++++++++++++++++++++++++++++++++++++++++++++point
If strType="1" Then
TarPts=rhino.GetObjects("Select target POINTS",1)
If isnull(TarPts) Then Exit Function
NumPts=ubound(TarPts)
If UAmount<1 Then'percentage control
If blnBitmap="1" Then'use bitmap control
each_point_percent=Pts_bitmap_percent(Tarpts)
If isnull(each_point_percent) Then:Convert2pts=Null: Exit Function:End If
temp(0)=filterPts_percent(TarPts,UAmount,1,each_point_percent)
End If
If blnBitmap="2" Then'not using bitmap control
temp(0)=filterPts_percent(TarPts,UAmount,0)
End If
End If
If UAmount<NumPts And UAmount>1 Then 'sample Uamount of points out of Total selected points
If blnBitmap="1" Then'use bitmap control
End If
If blnBitmap="2" Then'not using bitmap control
UAmount=UAmount/NumPts
temp(0)=filterPts_percent(TarPts,UAmount,0)
End If
End If
If UAmount>=NumPts Or UAmount=1 Then
temp(0)=TarPts
End If
rhino.MoveObjects temp(0),array(0,0,0),array(0,0,50)
End If
'+++++++++++++++++++++++++++++++++++++++++++++++++curve
If strType="2" Then
tarCrvs=rhino.GetObjects("Select target CURVES",4)
If isnull(tarCrvs) Then Exit Function
If UAmount<=1 Then
rhino.Print"Please give target amount,instead of giving percentage"
Exit Function
End If
End If
'+++++++++++++++++++++++++++++++++++++++++++++++++surface
If strType="3" Then
tarsrfs=rhino.GetObjects("Select target SURFACES",8)
If isnull(tarsrfs) Then Exit Function
If UAmount<=1 Then
rhino.Print"Please give target amount,instead of giving percentage"
Exit Function
End If
End If
'+++++++++++++++++++++++++++++++++++++++++++++++++volumn
If strType="4" Then
tarPlsfs=rhino.GetObjects("Select target POLY-SURFACES",16)
If isnull(tarPlsfs) Then Exit Function
If UAmount<=1 Then
rhino.Print"Please give target amount,instead of giving percentage"
Exit Function
End If
End If
'+++++++++++++++++++++++++++++++++++++++++++++++++
Dim nSr,nTr
nSr=rhino.UnselectAllObjects'num_Source
nTr=rhino.UnselectAllObjects'num_Target
End Function
Function Pts_bitmap_percent(ByVal all)
Dim pic,box1,box2,n,i,height(),arrpercent(),maxH,srf,lines()
box1=rhino.BoundingBox(all)
rhino.EnableRedraw False:rhino.AddPolyline array(box1(0),box1(1),box1(2),box1(3),box1(0)):rhino.EnableRedraw True
Rhino.Print "Pick a image and apply on the corner of target objects' bounding box"
rhino.Command "Heightfield"
srf=rhino.LastCreatedObjects()
If Not isarray(srf) Then: Pts_bitmap_percent=Null: Exit Function:End If
pic=srf(0)
box2=rhino.boundingbox (pic)
rhino.MoveObject pic,array(0,0,box2(0)(2)),array(0,0,0)
If rhino.Distance(box2(1),box2(5))=0 Then: rhino.Print "you chose a flat image, failed to sample": Pts_bitmap_percent=Null: Exit Function:End If
maxH=rhino.Distance(box2(1),box2(5))
n=ubound(all)
totalH=0
Dim cloestparam,arrpt,evalpt,arrptxyz
rhino.EnableRedraw False
For i=0 To n
ReDim Preserve height(i)
ReDim Preserve arrpercent(i)
ReDim Preserve lines(i)
arrptxyz=rhino.PointCoordinates(all(i))
arrpt=array(arrptxyz(0),arrptxyz(1),0)
If arrpt(0)>=box2(0)(0) And arrpt(0)<=box2(1)(0) And arrpt(1)>=box2(0)(1) And arrpt(1)<=box2(2)(1) Then
'cloestparam=rhino.SurfaceClosestPoint(pic,arrpt)':rhino.Print cloestparam(0)&","&cloestparam(1)
'evalpt=rhino.EvaluateSurface (pic,cloestparam)':rhino.Print evalpt(0)&","&evalpt(1)&","&evalpt(2)
evalpt=rhino.ProjectPointToSurface(array(arrpt),pic,array(0,0,1))(0)
height(i)=rhino.Distance (arrpt,evalpt)':rhino.Print height(i)
'lines(i)=rhino.AddLine (arrpt,evalpt)
arrpercent(i)=height(i)/maxH
Else
arrpercent(i)=0
End If
'rhino.Print "the "&i+1&" th point's selective chance is "&int(arrpercent(i)*10000)/100&"%========"
Next
rhino.DeleteObject pic
rhino.EnableRedraw True
Pts_bitmap_percent=arrpercent
End Function
Function filterPts_percent(ByVal all,ByVal fixpercent,ByVal blnbitmap,ByVal FloatPercent)
Dim n:n=Int(ubound(all)*fixpercent+fixpercent)
rhino.Print "========"&n&" points picked out of "&ubound(all)&","&" "&int(fixpercent*10000)/100&"%========"
Dim arrStart,arrLeft(),arrNew(),arrLeftFloatPercent()
Dim i,iLt,iNw,count,countleft,k
arrStart=all
arrStartFloatPercent=FloatPercent
iNw=0
iLt=0
count=0
k=0
countleft=0
Do Until count=n
For i=0 To ubound(arrstart)
If blnbitmap=0 Then percent=fixpercent
If blnbitmap=1 Then percent=arrStartFloatPercent(i)
If yes_no(percent)>0 Then
ReDim Preserve arrayNew(iNw)
arrayNew(iNw) = arrStart(i)
iNw=iNw+1
count=count+1
'rhino.Print "the "&count&"th IN"
If count=n Then i=ubound(arrstart)
Else
ReDim Preserve arrLeft(iLt)
ReDim Preserve arrLeftFloatPercent(iLt)
arrLeft(iLt) = arrStart(i)
If blnbitmap=1 Then arrLeftFloatPercent(iLt)=arrStartFloatPercent(i)
iLt=iLt+1
countleft=countleft+1
'rhino.Print "the "&countleft&"th OUT"
End If
Next
k=k+1
rhino.Print "=============filtering "&k&"th loop is done============"
If k=5 Then: count=n:rhino.Print "there are not enough points under bitmap, stopped automatically"
arrStart=arrLeft
If blnbitmap=1 Then arrStartFloatPercent=arrLeftFloatPercent
Loop
filterPts_percent=arrayNew
'samplePts_percent=all
End Function
Function str2real(ByVal str)
str2real=rhino.Str2Pt(str&",0,0")(0)
End Function
Function yes_no(ByVal percent)
Dim temp
temp=rnd+percent-1
'rhino.Print temp
If temp>0 Then yes_no=1
If temp<=0 Then yes_no=-1
End Function
没有评论:
发表评论