Multi-Curve random extrusion for building blocks

you need to prepare the footprint of the building blocks. feature:

• tolerance set up
• auto fix unclosed curve, count shows in command
• random heights controlled by 'step' method, for the easy control of floor amount
• failed block-making geometries will be highlighted by selecting at the end of procedure

 

Call Main()
Sub Main()
    Dim objs:objs=rhino.GetObjects("select curves",4,True,True)
    If isnull(objs) Then Exit Sub
    rhino.Command "selnone"
    Dim minpre,maxpre,steppre,closepre
    'Rhino.DeleteDocumentData "data"
    If isnull(rhino.GetDocumentData("data")) Then
        rhino.setdocumentdata "data","min","0"
        rhino.setdocumentdata "data","max","0"
        rhino.setdocumentdata "data","step1","0"
        rhino.setdocumentdata "data","close","0"
    End If

    minpre=str2real(rhino.GetDocumentData("data","min"))
    maxpre=str2real(rhino.GetDocumentData("data","max"))
    steppre=str2real(rhino.GetDocumentData("data","step1"))
    closepre=str2real(rhino.GetDocumentData("data","close"))
    Dim min,max,step1,close
    close=rhino.Getreal("close curve tolerrence? (0=keep as it)",closepre,0)
    If isnull(close) Then Exit Sub
    min=rhino.getreal("min height?",minpre,0)
    If isnull(min) Then Exit Sub
    max=rhino.getreal("max height?",maxpre,min)
    If isnull(max) Then Exit Sub
    step1=rhino.getinteger("How Many Step? (0 = no step)",steppre)
    If isnull(step1) Then Exit Sub
    rhino.setdocumentdata "data","min",min
    rhino.setdocumentdata "data","max",max
    rhino.setdocumentdata "data","step1",step1
    rhino.setdocumentdata "data","close",close
    Dim n:n=ubound(objs)
    Dim i,edge,btm,top,height,ngm,ng
    ngm=0
    ng=0
    For i=0 To n
        rhino.EnableRedraw False

        height=min*(1+rhino.Floor(rnd*(step1+1))/step1)
        Dim gap: gap=rhino.Distance(rhino.CurveStartPoint(objs(i)),rhino.CurveEndPoint(objs(i)))
        If Not(close=0) And (rhino.IsCurveClosable(objs(i),close)=True)Then
            rhino.Print "system-fixable gap found.."
            objs(i)=rhino.CloseCurve (objs(i),close)   
            ng=ng+1
            rhino.Print "system-fixable gap fixed!!--No."&ng
        ElseIf gap<close And gap>0 Then           
            rhino.print "gap needs to be fixed manally.."
                Dim line:line=rhino.AddLine(rhino.CurveStartPoint(objs(i)),rhino.CurveEndPoint(objs(i)))
            objs(i)=rhino.JoinCurves(array(objs(i),line),True)(0)
            ngm=ngm+1
            rhino.print "gap needs to be fixed manally has been fixed!!--No."&ngm
        End If       
        edge=rhino.ExtrudeCurveStraight( objs(i),array(0,0,0),array(0,0,height))
        If (rhino.IsCurveClosed(objs(i))=True) And (rhino.IsCurvePlanar(objs(i))=True) Then
            btm=rhino.AddPlanarSrf(array(objs(i)))(0)
            top=rhino.CopyObject(btm,array(0,0,0),array(0,0,height))
            rhino.JoinSurfaces array(btm,edge,top),True
        Else
            rhino.SelectObject objs(i)
            rhino.SelectObject edge
        End If
    Next
    rhino.EnableRedraw True
End Sub

Function str2real(str)
    str2real=rhino.Str2Pt(str&",0,0")(0)   
End Function

digital project shortcut and alias list

Took me 8 hours to setup, you guys should be happy now…enjoy!

note:

catia system is capital sensitive. be aware your caps lock…

xScatter plugin final

 

new feature:

• clone based on points,lines,surfaces
• auto guess object center or manually assign center to seeds
• orientation related to camera or selected point
• scattering within selected camera’s viewport to save system memory

 

 

 

scatter almost done

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

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

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

UnEvenOffset + Rondom scale Copier

 

 

Rondom Copier:

Option Explicit
'Script written by <Xarch.blogspot.com>
'Script copyrighted by <insert company name>
'Script version Thursday, April 09, 2009 11:00:35 AM

Call LEAVES()
Sub LEAVES()
    Dim anglestart:anglestart=0 'prerotate degree
    Dim anglerand:anglerand=5 'random rotate degree    
    Dim scalestart:scalestart=1 'starting scale factor
    Dim scaleend:scaleend=0.4 'ending scale factor
    Dim scalerand:scalerand=0.8 'random scale factor range(0-1)
    Dim biasRetaindeletion:biasRetaindeletion=80 ' range (0-100) keep 60 out of 100, delete randomly 40, 100 mean keep all

    Dim num:num=rhino.GetInteger("howmany?",30,2)
    Dim initLv:initLv=rhino.getobject("Select the leave",,True,True)
    Dim copypt:copypt=rhino.GetPoint("the copy base point?")
    Dim pathes:pathes=rhino.GetObjects("select the pathes",4)
    Dim path,i,copytargpt,dup,dup2,rotangle,tengentvec,scalefactor,mirrorline
    rhino.EnableRedraw False
    For Each path In pathes
        For i=1 To num-1
        copytargpt=rhino.DivideCurveLength(path,(rhino.CurveLength(path)/num))(i)
            dup=rhino.CopyObject(initLv, copypt,copytargpt)
            dup2=rhino.copyObject(initLv, copypt,copytargpt)
            tengentvec=rhino.CurveTangent(path,rhino.CurveClosestPoint(path,copytargpt))       
            If tengentvec(1)>=0 Then
                rotangle=90+rhino.Angle2(array(array(0,0,0),array(1,0,0)),array(array(0,0,0),tengentvec))(0)
            Else
                rotangle=90-rhino.Angle2(array(array(0,0,0),array(1,0,0)),array(array(0,0,0),tengentvec))(0)
            End If
            rhino.RotateObject dup,copytargpt,(rotangle-anglestart+anglerand*2*(rnd-0.5))
            rhino.RotateObject dup2,copytargpt,(rotangle-anglestart+anglerand*2*(rnd-0.5))
            rhino.mirrorObject dup2,copytargpt,rhino.PointAdd(copytargpt,tengentvec)
            scalefactor=(((scaleend-scalestart)*(i-1))/num+scalestart)*((1-scalerand)*rnd+scalerand)
            rhino.ScaleObject dup,copytargpt,array(scalefactor,scalefactor,1)

            scalefactor=(((scaleend-scalestart)*(i-1))/num+scalestart)*((1-scalerand)*rnd+scalerand)
            rhino.ScaleObject dup2,copytargpt,array(scalefactor,scalefactor,1)
            If (rnd-biasRetaindeletion/100)>0 Then
                rhino.DeleteObject dup
            End If
            If (rnd-biasRetaindeletion/100)>0 Then
                rhino.DeleteObject dup2
            End If       
        Next
    Next
    rhino.EnableRedraw True
End Sub

-----------------------------------------------------------------------------------------------

-----------------------------------------------------------------------------------------------

UnEvenOffset:

Option Explicit
'Script written by <Xarch.blogspot.com>
'Script copyrighted by <Xarch.blogspot.com>
'Script version Monday, April 20, 2009 5:08:21 PM

Call Main()
Sub Main()
    Dim lines:lines=rhino.GetObjects("select lines to uneven-offset",4,True,True)
    Dim pt1,disstart,pt2,disend,BlnEndcap
    Dim q1:q1=rhino.Getstring("offset distance at start?","Click_on_Screen",array

("ESC_for_typein"))
    If isnull(q1) Or q1="ESC_for_typein" Then
        disstart=rhino.GetReal("offset distance at start?")
        If isnull(disstart) Then Exit Sub
    End If   
    If q1="Click_on_Screen" Then
        pt1=rhino.GetPoints(True,,"offset distance at

start?",,1,rhino.CurveStartPoint(lines(0)))
        disstart=rhino.distance(rhino.CurveStartPoint(lines(0)),pt1(0))
    End If
    Dim q2:q2=rhino.Getstring("offset distance at end?","Click_on_Screen",array

("O","ESC_for_typein"))
    If isnull(q2) Or q2="ESC_for_typein" Then
        disend=rhino.GetReal("offset distance at end?")
        If isnull(disend) Then Exit Sub
    End If
    If q2="0" Or q2="O" Then disend=0
    If q2="Click_on_Screen" Then
        pt2=rhino.GetPoints(True,,"offset distance at end?",,1,rhino.CurveendPoint

(lines(0)))
        disend=rhino.distance(rhino.CurveendPoint(lines(0)),pt2(0))
    End If
    If disend<>0 Then
        'Dim q3:q3=rhino.GetString("cap end?","yes")
        'If q3="yes" Then BlnEndcap=1
        BlnEndcap=1
    End If
    Dim line,offlines,cap
    Dim strLayer
    strLayer=Rhino.AddLayer("offsetCrvs", RGB(255, 0, 0))
    For Each line In lines
        offlines=movepts(line,disstart,disend,BlnEndcap)

    Next
End Sub

Function movepts(ByVal line,ByVal disstart,ByVal disend,ByVal BlnEndcap)
    Dim CvPts:CvPts=rhino.CurvePoints(line)
    Dim num:num=ubound(CvPts)
    Dim newCvPts1(),newCvPts2(),newCvPts3(6),distance(),closestNum(),CurvatureVec

(),moveVec1(),moveVec2()
    Dim i
    For i=0 To num
        ReDim Preserve closestNum(i)
        ReDim Preserve distance(i)
        ReDim Preserve CurvatureVec(i)
        ReDim Preserve moveVec1(i)
        ReDim Preserve moveVec2(i)
        ReDim Preserve newCvPts1(i)
        ReDim Preserve newCvPts2(i)
        closestNum(i)=rhino.CurveClosestPoint(line,CvPts(i))       
        distance(i)=(disend*(closestNum(i)-rhino.CurveDomain(line)(0)_
            )+disstart*(rhino.CurveDomain(line)(1)-closestNum(i)))/(_
            rhino.CurveDomain(line)(1)-rhino.CurveDomain(line)(0))
        CurvatureVec(i)=rhino.VectorCrossProduct( array(0,0,1),rhino.CurveCurvature

(line,closestNum(i))(1))
        moveVec1(i)=rhino.VectorScale(rhino.VectorUnitize(CurvatureVec(i)),distance

(i))
        moveVec2(i)=rhino.VectorReverse(moveVec1(i))
        'rhino.AddLine rhino.EvaluateCurve(line,closestNum(i)),rhino.PointAdd

(rhino.EvaluateCurve(line,closestNum(i)),moveVec1(i))
        newCvPts1(i)=rhino.PointAdd(CvPts(i),moveVec1(i))
        newCvPts2(i)=rhino.PointAdd(CvPts(i),moveVec2(i))
    Next
    Dim cv()
    ReDim Preserve cv(0)
    cv(0)=rhino.AddCurve(newCvPts1)   
    rhino.objectlayer cv(0),"offsetCrvs"
    ReDim Preserve cv(1)
    cv(1)=rhino.AddCurve(newCvPts2)
    rhino.objectlayer cv(1),"offsetCrvs"
    If BlnEndcap=1 Then
        Dim vecExt1,vecExt2
        vecExt1=rhino.VectorScale(rhino.VectorUnitize(rhino.curvetangent(cv

(0),rhino.CurveDomain(cv(0))(1))),disend)
        vecExt2=rhino.VectorScale(rhino.VectorUnitize(rhino.curvetangent(cv

(1),rhino.CurveDomain(cv(1))(1))),disend)
        newCvPts3(0)=rhino.CurveEndPoint(cv(0))
        newCvPts3(1)=rhino.PointAdd(newCvPts3(0),vecExt1)
        newCvPts3(2)=rhino.PointAdd(newCvPts3(1),vecExt1)
        newCvPts3(6)=rhino.CurveEndPoint(cv(1))
        newCvPts3(5)=rhino.PointAdd(newCvPts3(6),vecExt2)
        newCvPts3(4)=rhino.PointAdd(newCvPts3(5),vecExt2)
        newCvPts3(3)=rhino.pointscale (rhino.PointAdd (rhino.pointadd (newCvPts3

(4),vecExt2),rhino.pointadd (newCvPts3(2),vecExt1)),0.5)
        ReDim Preserve cv(2)
        cv(2)=rhino.AddCurve(newCvPts3)
        rhino.objectlayer cv(2),"offsetCrvs"
    End If

    movepts=cv
End Function

关于Demonoid的介绍

Demonoid,是一个BitTorrent 网站，因为能够提供丰富优质的Torrents下载，受到很多人的青睐。
但为了减轻网站的承载负担，于是限制了注册，需要有人邀请，发送邀请码才能注册。
网站是由一个匿名的名南斯拉夫人于2003年4月21日建立的。
这个网站的注册会员（免费注册）需每周在网站上下3个以上的BT文件，或者得要定期下载一些旧的BT文件。（可想而知，BT一些旧美剧以及旧版兼容软件速度会不耐）。

我个人很喜欢 P2P 这个伟大的发明，它让我们有机会接触到更多优秀的信息和内容。但知识产权也是应该得到保护的。在“分享”已经成为主旋律的今天，我个人认为版权保护和分享 本身不应该是矛盾的对立双方，单纯的买卖关系已经不适应现在的分享方式。探寻新的分享方式，使分享方和版权所有者能达到双赢，才是 Torrent 组织和版权保护组织真正应该坐下来讨论的事情。

Demonoid.com以前每周五可以免费开放注册，但2007年3月3日网站宣告：以后每月开放注册一次。此外，想要注册的人只能通过现有注册人员发送的邀请码，在网站未开放免费注册的时间里注册。
实在需要邀请码的来这里看看http://blog.119797.com/article/demonoid-invitation-codes/

plugin | unroll srf or brep into ordered plan

 

This little code is just for unroll a bunch of surfaces. The parameter include ordering by "bounding box size" or by spatial location, with or without labels.

if no srf or brep is selected, will show: , if only one srf  is selected will show: , lol….

the core of the code is the “order by size” and the “smash” rhino command.

these are the samples:

                without label                                          with/without label                     

                   by spatial relation                                             by size

 

Click to download plugin: drag to your rhino and you are all set.

Run it by typing command "xUnroll" or go to the menu "xTools".

__________________________________________________________

Option Explicit
'Script written by <xarch.blogspot.com>
'Script copyrighted by <xarch.blogspot.com>
'Script version Monday, January 12, 2009 4:33:17 PM

Call Main()
Sub main()

    Dim breps: breps=rhino.getobjects("select Srfs or breps",,True,True)
    If isnull(breps) Then Exit Sub
    Dim spacingfactor:
    spacingfactor=rhino.getreal("spacing factor?",2,0.001) 'x time biggest panel size
    If isnull(spacingfactor) Then Exit Sub
    Dim BestGuessSwitch
    BestGuessSwitch=rhino.getstring("Order method, by spatical location?","Yes",array("Size"))
    If isnull(BestGuessSwitch) Then Exit Sub
    If BestGuessSwitch="Yes" Then BestGuessSwitch=1
    If BestGuessSwitch="Size" Then BestGuessSwitch=2
    '1=order by spatical location(exploded)
    '2=order by size   
    Dim ShowTagSwitch
    ShowTagSwitch=rhino.getstring("add Label?","No",array("Yes"))
    If ShowTagSwitch="Yes" Then ShowTagSwitch=1
    If ShowTagSwitch="No" Then ShowTagSwitch=0
    Dim brep,n1,brepstemp()
    n1=0
    For Each brep In breps
        If rhino.ObjectType(brep)=8 Or rhino.ObjectType(brep)=16 Then
            ReDim Preserve brepstemp(n1)
        brepstemp(n1)=brep
            n1=n1+1       
        End If
    Next
    If n1=0 Then
        rhino.MessageBox "No srf selected"
        Exit Sub
    End If
    Call unrollsrfs(brepstemp,spacingfactor,BestGuessSwitch,ShowTagSwitch)
End Sub

Function unrollsrfs(ByVal breps,ByVal spacingfactor,ByVal BestGuessSwitch,ByVal ShowTagSwitch)
    Dim n:n=ubound(breps)
    If n<=0 Then
        rhino.MessageBox "Need 2 or more srfs to run, you lazybone!"
        Exit Function
    End If
    Dim allcenter:allcenter=rhino.Pointscale(rhino.PointAdd(rhino.BoundingBox(breps)(0),rhino.BoundingBox(breps)(6)),0.5)
    Dim sortsize,spacing,center
    sortsize=SortSrfBySize(breps)
    spacing=sortsize(1)(0)
    center=sortsize(2)
    ' testing
    'rhino.AddTextDot "the biggest panel is "&spacing , sortsize(2)(0)
    'rhino.AddTextDot "the smallest panel is "&sortsize(1)(n) , sortsize(2)(n)
    Dim k,obj,arrobj,arrUnroll
    k=-1
    arrUnroll = Array()
    If BestGuessSwitch=0 Then arrobj=breps
    If BestGuessSwitch=1 Then arrobj=sortsize(0)
    If BestGuessSwitch=2 Then arrobj=sortsize(0)
    rhino.EnableRedraw False
    For Each obj In arrobj
        k = k + 1
        If ShowTagSwitch=1 Then rhino.addtextdot k, center(k)
        Call Rhino.UnselectAllObjects
        Call Rhino.SelectObject(obj)
        'Call Rhino.Command (CStr("_smash LinearDirection=Natural _Enter Explode=No Labels=No _Enter"), vbFalse)       
        Call Rhino.Command (CStr("_smash _Enter _Enter"), vbFalse)       
        ReDim Preserve arrUnroll(k)
        arrUnroll(k) = Rhino.FirstObject
        If BestGuessSwitch=2 Then
            rhino.MoveObject arrUnroll(k),array(0,0,0),array((k Mod 10)*spacingfactor*spacing,(k\10)*spacingfactor*spacing,0)
            If ShowTagSwitch=1 Then rhino.addtextdot k&"'", array((k Mod 10)*spacingfactor*spacing,(k\10)*spacingfactor*spacing,0)
        End If
        If BestGuessSwitch=1 Then
            Dim vecMove:vecMove=rhino.vectorScale(rhino.VectorUnitize(_
                rhino.vectorcreate(center(k),allcenter)),((rhino.distance(center(k),allcenter)+spacingfactor*spacing)*2))
            rhino.MoveObject arrUnroll(k),array(0,0,0),array(vecMove(0),vecMove(1),0)
            If ShowTagSwitch=1 Then rhino.addtextdot k&"'", array(vecMove(0),vecMove(1),0)
        End If
    Next
    rhino.EnableRedraw True
End Function

Function SortSrfBySize (ByVal objs)
    Dim n:n=ubound(objs)
    Dim i,j,k,boxLong(),objtemp,boxcenter(),temp(2),boxLongTemp
    For k=0 To n       
        ReDim Preserve boxLong(k)
        boxLong(k)=rhino.distance(rhino.BoundingBox(objs(k))(0),rhino.BoundingBox(objs(k))(6))
    Next
    For i=0 To n-1
        For j=0 To n-1
            If j<n-1-i Then
                If boxLong(j)<boxLong(j+1) Then
                    objtemp=objs(j)
                    objs(j)=objs(j+1)
                    objs(j+1)=objtemp
                    boxLongTemp=boxLong(j)
                    boxLong(j)=boxLong(j+1)
                    boxLong(j+1)=boxLongTemp
                End If
            End If       
        Next       
    Next
    For k=0 To n       
        ReDim Preserve boxcenter(k)   
        boxcenter(k)=rhino.Pointscale(rhino.PointAdd(rhino.BoundingBox(objs(k))(0),rhino.BoundingBox(objs(K))(6)),0.5)
    Next

    temp(0)=objs
    temp(1)=boxLong
    temp(2)=boxcenter
    SortSrfBySize=temp
    'SortSrfBySize(0) are the sorted srfs ID
    'SortSrfBySize(1) are the sorted size dimension - SortSrfBySize(1)(0) is the biggest srf diaganal size
    'SortSrfBySize(2) are the array of the center points
End Function

function | sort surface size by bounding box

input:

breps or srfs, amount>=2

output:

(0)   sorted srfs ID

(1)  sorted size dimension - SortSrfBySize(1)(0) is the biggest srf diaganal size

(2)  the array of the center points

 

Function SortSrfBySize (ByVal objs)
    Dim n:n=ubound(objs)
    Dim i,j,k,boxLong(),objtemp,boxcenter(),temp(2)
    For i=0 To n-1
        For j=0 To n-1
            ReDim Preserve boxLong(j)
            boxLong(j)=rhino.distance(rhino.BoundingBox(objs(j))(0),rhino.BoundingBox(objs(j))(6))
            ReDim Preserve boxLong(j+1)
            boxLong(j+1)=rhino.distance(rhino.BoundingBox(objs(j+1))(0),rhino.BoundingBox(objs(j+1))(6))
            If boxLong(j)<boxLong(j+1) Then
                objtemp=objs(j)
                objs(j)=objs(j+1)
                objs(j+1)=objtemp
            End If       
        Next       
    Next
    For k=0 To n       
        ReDim Preserve boxcenter(k)   
        ReDim Preserve boxLong(k)
        boxcenter(k)=rhino.Pointscale(rhino.PointAdd(rhino.BoundingBox(objs(k))(0),rhino.BoundingBox(objs(K))(6)),0.5)
        boxLong(k)=rhino.distance(rhino.BoundingBox(objs(k))(0),rhino.BoundingBox(objs(k))(6))
    Next
    temp(0)=objs
    temp(1)=boxLong
    temp(2)=boxcenter
    SortSrfBySize=temp
    'SortSrfBySize(0) are the sorted srfs ID
    'SortSrfBySize(1) are the sorted size dimension - SortSrfBySize(1)(0) is the biggest srf diaganal size
    'SortSrfBySize(2) are the array of the center points
End Function

sub start | select brep and srfs

filters and assures only srf or breps go into procedure array

____________________________________________________

Dim breps: breps=rhino.getobjects("select Srfs or breps",,True,True)
If isnull(breps) Then Exit Sub
Dim brep,n1,brepstemp()
n1=0
For Each brep In breps
If rhino.ObjectType(brep)=8 Or rhino.ObjectType(brep)=16 Then
ReDim Preserve brepstemp(n1)
brepstemp(n1)=brep
n1=n1+1
End If
Next
If n1=0 Then
rhino.MessageBox "No srf selected"
Exit Sub
End If