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
