2009年6月18日星期四
2009年6月17日星期三
select points by bitmap
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
2009年6月3日星期三
xZigzag
for the Mughal carpet design
Option Explicit
'Script written by <insert name>
'Script copyrighted by <insert company name>
'Script version Tuesday, June 02, 2009 5:08:23 PM
Call Main()
Sub Main()
Dim segpts,dataSeg,datadist,linetype,maxDist,offsetRate
Dim LINES:LINES=RHINO.GetObjects("select base lines", 4, True,True)
If isnull(lines) Then Exit Sub
maxDist=minLength(lines)
If isnull(rhino.GetDocumentData("zigzag")) Then
rhino.SetDocumentData"zigzag","d0","1" '"By Segment(1), or by distance(0)"
rhino.SetDocumentData"zigzag","d1","0" '"fixed 90deg(0),or offset percent(vs.width)"
rhino.SetDocumentData"zigzag","d2","1" '"Curve on 2sides(1),or right only(0)"
rhino.SetDocumentData"zigzag","d3"," "
rhino.SetDocumentData"zigzag","d4","10" '"if bySegment,How Many?"
rhino.SetDocumentData"zigzag","d5","1.0" '"if byLength,How Long?(0=pickup on Screen)"
rhino.SetDocumentData"zigzag","d6",maxDist&"(read only)" '"The shortest curve length is:"
End If
Dim d1,d2,d0,d3,d5,d6,d4
d0=rhino.GetDocumentData("zigzag","d0")
d1=rhino.GetDocumentData("zigzag","d1")
d2=rhino.GetDocumentData("zigzag","d2")
d3=rhino.GetDocumentData("zigzag","d3")
d4=rhino.GetDocumentData("zigzag","d4")
d5=rhino.GetDocumentData("zigzag","d5")
d6=rhino.GetDocumentData("zigzag","d6")
Dim box:box=Rhino.PropertyListBox(array("By Segment(1), or by distance(0)",_
"fixed 90deg(0),or offset percent(vs.width)",_
"Curve on 2sides(1),or right only(0)",_
" ",_
"if bySegment,How Many?>1",_
"if byLength,How Long?(0=pickup on Screen)",_
"The shortest curve length is:"),_
array(d0,d1,d2,d3,d4,d5,d6),"options:","Zigzagize lines:")
If isnull(box) Then Exit Sub
rhino.SetDocumentData "zigzag","d0",box(0)
rhino.SetDocumentData "zigzag","d1",box(1)
rhino.SetDocumentData "zigzag","d2",box(2)
rhino.SetDocumentData "zigzag","d3"," "
rhino.SetDocumentData "zigzag","d4",box(4)
rhino.SetDocumentData "zigzag","d5",box(5)
rhino.SetDocumentData "zigzag","d6",maxDist&"(read only)"
'rhino.SetDocumentData "zigzag","d3",box(3)
If box(0)="1" Then 'by segment
dataSeg=rhino.Str2Pt(rhino.GetDocumentData("zigzag","d4")&",0,0")(0)
Dim numseg:numseg=dataSeg
If box(1)="0" Then
linetype="^^^^"
offsetRate=0.5
Else
offsetRate=rhino.Str2Pt(box(1)&",0,0")(0)/100
linetype=rhino.GetString("Select linetype","VVVV",array("SSSS","unun","UUUU","OOOO"))
If isnull(linetype) Then Exit Sub
End If
segpts=pts_segment(lines,numseg,linetype,box(2),offsetRate)
End If
If box(0)="0" Then 'by length
If rhino.GetDocumentData("zigzag","d5")="0" Then
Dim user2pts
user2pts=rhino.GetPoints(True,,"pickup segment length,pick first point:","pickup second point:",2)
If isnull(user2pts) Then Exit Sub
datadist=rhino.Distance(user2pts(0),user2pts(1))
rhino.setDocumentData "zigzag","d5",datadist
Else
datadist=rhino.Str2Pt(rhino.GetDocumentData("zigzag","d5")&",0,0")(0)
End If
If datadist<0.0001 Or datadist>maxDist Then Exit Sub
If box(1)="0" Then
linetype="^^^^"
offsetRate=0.5
Else
offsetRate=rhino.Str2Pt(box(1)&",0,0")(0)/100
linetype=rhino.GetString("Select linetype","VVVV",array("SSSS","unun","UUUU","OOOO"))
If isnull(linetype) Then Exit Sub
End If
segpts=pts_distance(lines,datadist,linetype,box(2),offsetRate)
End If
End Sub
Function pts_segment(ByVal lines,ByVal numseg,ByVal linetype,ByVal mirror,ByVal offsetRate)' provides points array for each line (by segment)
rhino.EnableRedraw False
Dim ptsonLine()
Dim num:num=ubound(lines)
Dim i,j
For i=0 To num
ReDim Preserve ptsonLine(i)
ptsonLine(i)=rhino.dividecurve(lines(i),numseg)
If rhino.Distance(rhino.CurveStartPoint(lines(i)),rhino.curveendpoint(lines(i)))=0 Then
ptsonLine(i)=pts_add_1pt(ptsonLine(i),rhino.CurveEndPoint(lines(i)))
End If
'rhino.AddPoints ptsonLine(i)
decoLine ptsonLine(i),linetype,mirror,offsetRate
Next
rhino.EnableRedraw True
End Function
Function pts_distance(ByVal lines,ByVal distseg,ByVal linetype,ByVal mirror,ByVal offsetRate)' provides points array for each line (by distance)
rhino.EnableRedraw False
Dim ptsonLine()
Dim num:num=ubound(lines)
Dim i,j,ptsNum
For i=0 To num
ReDim Preserve ptsonLine(i)
ptsonLine(i)=rhino.DivideCurveLength (lines(i),distseg)
ptsNum=ubound(ptsonLine(i))
If rhino.distance(ptsonLine(i)(ptsNum),rhino.CurveEndPoint(lines(i)))>0 Then
ptsonLine(i)=pts_add_1pt(ptsonLine(i),rhino.CurveEndPoint(lines(i)))
' rhino.AddPoints ptsonLine(i)
decoLine ptsonLine(i),linetype,mirror,offsetRate
End If
Next
rhino.EnableRedraw True
End Function
Function pts_add_1pt(ByVal pts,ByVal pt)' add the last point into points array
Dim n:n=ubound(pts)
Dim i,strpts,ptsfromstr
strpts=rhino.Pt2Str(pts(0))
For i=1 To n
strpts=strpts&" "&rhino.Pt2Str(pts(i))
Next
strpts=strpts&" "&rhino.Pt2Str(pt)
pts_add_1pt=rhino.Str2PtArray(strpts)
End Function
Function minLength(ByVal lines)
Dim n:n=ubound(lines)
Dim leng(),i
For i=0 To n
ReDim Preserve leng(i)
leng(i)=rhino.CurveLength(lines(i))
Next
Dim j,temp,k
For k=0 To n-1
For j=0 To n-1
If leng(j)>leng(j+1) Then
temp=leng(j+1)
leng(j+1)=leng(j)
leng(j)=temp
End If
Next
Next
minLength=leng(0)
end function
Function decoLine(ByVal pts,ByVal linetype,ByVal mirror,ByVal offsetRate)
Dim newpts1(),newpts2(),lines(1),i,n,c1,c2,q1,q2,p1,p2,c3,cc1,cc2,cc3,cc4,t1,t2,t3,t4,t5,t6,t7,t8
n=ubound(pts)
If linetype="^^^^" Or linetype="VVVV" Then
For i=0 To n-1
ReDim Preserve newpts1(i*2)
newpts1(i*2)=pts(i)
ReDim Preserve newpts1(i*2+1)
newpts1(i*2+1)=offptfinder1(pts(i),pts(i+1),offsetrate)
ReDim Preserve newpts2(i*2)
newpts2(i*2)=pts(i)
ReDim Preserve newpts2(i*2+1)
newpts2(i*2+1)=offptfinder1(pts(i+1),pts(i),offsetrate)
Next
ReDim Preserve newpts1(2*n)
newpts1(2*n)=pts(n)
ReDim Preserve newpts2(2*n)
newpts2(2*n)=pts(n)
If linetype="^^^^" Or linetype="VVVV" Then
lines(0)=rhino.Addpolyline(newpts1)
If mirror="1" Then
lines(1)=rhino.Addpolyline(newpts2)
End If
Else
lines(0)=rhino.Addinterpcurve(newpts1)
If mirror="1" Then
lines(1)=rhino.Addinterpcurve(newpts2)
End If
End If
End If
If linetype="unun" Then
For i=0 To n-1
c1=rhino.PointScale(rhino.PointAdd(pts(i),pts(i+1)),0.5)
ReDim Preserve newpts1(i*4)
newpts1(i*4)=pts(i)
ReDim Preserve newpts1(i*4+1)
newpts1(i*4+1)=offptfinder1(pts(i),c1,offsetrate)
ReDim Preserve newpts1(i*4+2)
newpts1(i*4+2)=offptfinder1(pts(i),pts(i+1),offsetrate)
ReDim Preserve newpts1(i*4+3)
newpts1(i*4+3)=offptfinder1(c1,pts(i+1),offsetrate)
ReDim Preserve newpts2(i*4)
newpts2(i*4)=pts(i)
ReDim Preserve newpts2(i*4+1)
newpts2(i*4+1)=offptfinder1(c1,pts(i),offsetrate)
ReDim Preserve newpts2(i*4+2)
newpts2(i*4+2)=offptfinder1(pts(i+1),pts(i),offsetrate)
ReDim Preserve newpts2(i*4+3)
newpts2(i*4+3)=offptfinder1(pts(i+1),c1,offsetrate)
Next
ReDim Preserve newpts1(4*n)
newpts1(4*n)=pts(n)
ReDim Preserve newpts2(4*n)
newpts2(4*n)=pts(n)
lines(0)=rhino.Addinterpcurve(newpts1)
If mirror="1" Then
lines(1)=rhino.Addinterpcurve(newpts2)
End If
End If
If linetype="SSSS" Or linetype="UUUU" Then
For i=0 To n-1
c1=rhino.PointScale(rhino.PointAdd(pts(i),pts(i+1)),0.5)
c2=offptfinder1(pts(i),pts(i+1),offsetrate)
cc1=rhino.PointScale(rhino.PointAdd(pts(i),c2),0.5)
cc2=rhino.PointScale(rhino.PointAdd(pts(i+1),c2),0.5)
t1=rhino.PointScale(rhino.PointAdd(c1,cc1),0.5)
t2=rhino.PointSubtract(rhino.PointScale(cc1,2),t1)
t4=rhino.PointScale(rhino.PointAdd(c1,cc2),0.5)
t3=rhino.PointSubtract(rhino.PointScale(cc2,2),t4)
ReDim Preserve newpts1(i*8)
newpts1(i*8)=pts(i)
ReDim Preserve newpts1(i*8+1)
newpts1(i*8+1)=t1
ReDim Preserve newpts1(i*8+2)
newpts1(i*8+2)=cc1
ReDim Preserve newpts1(i*8+3)
newpts1(i*8+3)=t2
ReDim Preserve newpts1(i*8+4)
newpts1(i*8+4)=c2
ReDim Preserve newpts1(i*8+5)
newpts1(i*8+5)=t3
ReDim Preserve newpts1(i*8+6)
newpts1(i*8+6)=cc2
ReDim Preserve newpts1(i*8+7)
newpts1(i*8+7)=t4
c3=offptfinder1(pts(i+1),pts(i),offsetrate)
cc3=rhino.PointScale(rhino.PointAdd(pts(i),c3),0.5)
cc4=rhino.PointScale(rhino.PointAdd(pts(i+1),c3),0.5)
t5=rhino.PointScale(rhino.PointAdd(c1,cc3),0.5)
t6=rhino.PointSubtract(rhino.PointScale(cc3,2),t5)
t8=rhino.PointScale(rhino.PointAdd(c1,cc4),0.5)
t7=rhino.PointSubtract(rhino.PointScale(cc4,2),t8)
ReDim Preserve newpts2(i*8)
newpts2(i*8)=pts(i)
ReDim Preserve newpts2(i*8+1)
newpts2(i*8+1)=t5
ReDim Preserve newpts2(i*8+2)
newpts2(i*8+2)=cc3
ReDim Preserve newpts2(i*8+3)
newpts2(i*8+3)=t6
ReDim Preserve newpts2(i*8+4)
newpts2(i*8+4)=c3
ReDim Preserve newpts2(i*8+5)
newpts2(i*8+5)=t7
ReDim Preserve newpts2(i*8+6)
newpts2(i*8+6)=cc4
ReDim Preserve newpts2(i*8+7)
newpts2(i*8+7)=t8
Next
ReDim Preserve newpts1(8*n)
newpts1(8*n)=pts(n)
ReDim Preserve newpts2(8*n)
newpts2(8*n)=pts(n)
If linetype="SSSS" Then
lines(0)=rhino.Addinterpcurve(newpts1)
If mirror="1" Then
lines(1)=rhino.Addinterpcurve(newpts2)
End If
Else
lines(0)=rhino.addcurve(newpts1)
If mirror="1" Then
lines(1)=rhino.addcurve(newpts2)
End If
End If
End If
If linetype="OOOO" Then
For i=0 To n-1
c1=rhino.PointScale(rhino.PointAdd(pts(i),pts(i+1)),0.5)
c2=offptfinder1(pts(i),pts(i+1),offsetrate)
cc1=rhino.PointScale(rhino.PointAdd(pts(i),c2),0.5)
cc2=rhino.PointScale(rhino.PointAdd(pts(i+1),c2),0.5)
t1=rhino.PointAdd(rhino.PointScale(c1,0.75),rhino.PointScale(c2,0.25))
t2=rhino.PointSubtract(rhino.PointScale(cc1,2),t1)
t3=rhino.PointSubtract(rhino.PointScale(cc2,2),t1)
ReDim Preserve newpts1(i*6)
newpts1(i*6)=pts(i)
ReDim Preserve newpts1(i*6+1)
newpts1(i*6+1)=t1
ReDim Preserve newpts1(i*6+2)
newpts1(i*6+2)=t2
ReDim Preserve newpts1(i*6+3)
newpts1(i*6+3)=c2
ReDim Preserve newpts1(i*6+4)
newpts1(i*6+4)=t3
ReDim Preserve newpts1(i*6+5)
newpts1(i*6+5)=t1
c3=offptfinder1(pts(i+1),pts(i),offsetrate)
cc3=rhino.PointScale(rhino.PointAdd(pts(i),c3),0.5)
cc4=rhino.PointScale(rhino.PointAdd(pts(i+1),c3),0.5)
t5=rhino.PointAdd(rhino.PointScale(c1,0.75),rhino.PointScale(c3,0.25))
t6=rhino.PointSubtract(rhino.PointScale(cc3,2),t5)
t7=rhino.PointSubtract(rhino.PointScale(cc4,2),t5)
ReDim Preserve newpts2(i*6)
newpts2(i*6)=pts(i)
ReDim Preserve newpts2(i*6+1)
newpts2(i*6+1)=t5
ReDim Preserve newpts2(i*6+2)
newpts2(i*6+2)=t6
ReDim Preserve newpts2(i*6+3)
newpts2(i*6+3)=c3
ReDim Preserve newpts2(i*6+4)
newpts2(i*6+4)=t7
ReDim Preserve newpts2(i*6+5)
newpts2(i*6+5)=t5
Next
ReDim Preserve newpts1(6*n)
newpts1(6*n)=pts(n)
ReDim Preserve newpts2(6*n)
newpts2(6*n)=pts(n)
lines(0)=rhino.Addinterpcurve(newpts1)
If mirror="1" Then
lines(1)=rhino.Addinterpcurve(newpts2)
End If
End If
End Function
Function offptfinder1(ByVal pt1,ByVal pt2,ByVal offsetrate)
Dim pCenter,vCenter,vCrossUnit,vCross,dist
pCenter=rhino.PointScale(rhino.PointAdd(pt1,pt2),0.5)
'rhino.AddPoint pCenter
vCenter=rhino.VectorCreate(pt1,pt2)
dist=rhino.Distance(pt1,pt2)*offsetrate
vCrossUnit=rhino.VectorUnitize(rhino.VectorCrossProduct(vCenter,array(0,0,1)))
vCross=rhino.VectorScale(vCrossUnit,dist)
offptfinder1=rhino.PointAdd(pCenter,vCross)
'rhino.AddLine pCenter,offptfinder1
'rhino.AddPoint offptfinder1
End Function
2009年6月1日星期一
scatter-wip
Option Explicit
'Script written by <insert name>
'Script copyrighted by <insert company name>
'Script version Thursday, April 09, 2009 11:00:35 AM
Call scatter()
Sub scatter()
If isnull(rhino.GetDocumentData("scatter")) Then
rhino.SetDocumentData "scatter","D1","45"
rhino.SetDocumentData "scatter","D2","0.2"
rhino.SetDocumentData "scatter","D3","30"
End If
Dim d1,d2,d3
d1=rhino.GetDocumentData("scatter","D1")
d2=rhino.GetDocumentData("scatter","D2")
d3=rhino.GetDocumentData("scatter","D3")
Dim answers:answers=Rhino.PropertyListBox(array(_
"randomRotateDeg(0=none)","randomScale(0=none)",_
"ObjectMaintain(100=no del)"),array(d1,d2,d3),"Input number only:")
If isnull(answers) Then Exit Sub
rhino.SetDocumentData "scatter","D1",answers(0)
rhino.SetDocumentData "scatter","D2",answers(1)
rhino.SetDocumentData "scatter","D3",answers(2)
Dim strPrep:strPrep= answers(0)& ","& answers(1)& "," & answers(2)
Dim str2pt:str2pt=rhino.Str2Pt(strPrep)
Dim anglerand:anglerand=str2pt(0) 'random rotate degree
Dim scalerand:scalerand=str2pt(1) 'random scale intervane factor range : 0.2 means from 0.8-1.2
Dim biasRetaindeletion:biasRetaindeletion=str2pt(2) ' range (0-100) keep 60 out of 100, delete randomly 40, 100 mean keep all
Dim obj:obj=rhino.GetObject("copy source?",,True,True)
If isnull(obj) Then Exit Sub
Dim basept:basept=rhino.GetPoint("base point copy from?")
If isnull(basept) Then Exit Sub
Dim pts:pts=rhino.Getobjects("select copy-to points",1)
If isnull(pts) Then Exit Sub
rhino.EnableRedraw False
Dim pt,dup
For Each pt In pts
dup=rhino.CopyObject (obj, basept, rhino.PointCoordinates(pt))
rhino.RotateObject dup, rhino.PointCoordinates(pt),anglerand*2*(rnd-0.5)
rhino.scaleObject dup, rhino.PointCoordinates(pt),_
array((1+scalerand*2*(rnd-0.5)),(1+scalerand*2*(rnd-0.5)),1)
If (rnd-biasRetaindeletion/100)>0 Then
rhino.DeleteObject dup
End If
Next
rhino.EnableRedraw True
End Sub