2009年6月18日星期四

2009年6月17日星期三

select points by bitmap

snap1226        snap1227

 

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

052-

 052 

06-

snap1119

 

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

scatter SCATTER2

 

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