surfaces.morph.01

March.5.2010 - Leave a Response

Option Explicit
‘Script written by
‘Script copyrighted by
‘Script version Thursday, March 06, 2008 10:48:20 AM

Call Main()
Sub Main()
Dim surfaces,iterations,ctrlCrv
surfaces = Rhino.GetObjects(“Select Surfaces to Morph”,8)
If isNull(surfaces) Then Exit Sub
iterations = Rhino.GetReal(“Number of Objects Between Steps”, 5,1)
If isNull(iterations) Then Exit Sub
ctrlCrv = Rhino.GetBoolean(“Display Control Curves”,array(“curveStatus”,”delete”,”display”),array(False))

Call Rhino.EnableRedraw(False)
Call surfaceMorpher(surfaces,iterations,ctrlCrv(0))
Call Rhino.EnableRedraw(True)

End Sub
Function surfaceMorpher(surfaces,instances,crvBln)
surfaceMorpher = Null
Dim i,j,k,r,m
Dim Ucount,Vcount,Udom,Vdom,objCount,pCount,pDom
Dim arrU(),arrV(),domU(),domV()
Dim tempPtSet
Dim srfPts(),srfPtSet(),arrSrfPts(),ctrlCrvPts()
objCount = uBound(surfaces)
ReDim arrU(objCount), arrV(objCount),domU(objCount),domV(objCount)
‘Find out existing surface parameters
For i = 0 To objCount Step 1
pCount = Rhino.SurfacePointCount(surfaces(i))
pDom = Rhino.SurfaceDegree (surfaces(i))
arrU(i)=pCount(0)
arrV(i)=pCount(1)
domU(i) = pDom(0)
domV(i) = pDom(1)
‘Call Rhino.Print(arrU(i))
‘Call Rhino.Print(arrV(i))
Next
‘find you maximum values
Dim surfRe
Udom = Rhino.Max(domU)
Vdom = Rhino.Max(domV)
Ucount = Rhino.Max(arrU)
Vcount = Rhino.Max(arrV)

ReDim srfPts(Vcount),srfPtSet(Ucount),arrSrfPts(objCount)
‘rebuild the surfaces based on max values
For i = 0 To objCount Step 1
surfRe = Rhino.RebuildSurface(surfaces(i),array(Udom,Vdom), array(Ucount,Vcount))
Next
‘extract the surface control points
For i = 0 To objCount Step 1
tempPtSet = Rhino.SurfacePoints(surfaces(i))
m = 0
For j = 0 To Ucount-1 Step 1
For k = 0 To Vcount-1 Step 1
srfPts(k) = tempPtSet(m)
m=m+1
Next
srfPtSet(j) = srfPts
Next
arrSrfPts(i) = srfPtSet
Next
‘resequence and create blend points
ReDim ctrlCrvPts(objCount)

Dim ctrlCrv,crvDom,crvSteps
Dim finSrfPt(),finSrfSet(),arrFinSrfPts()
crvSteps = instances*objCount+objCount
ReDim finSrfSet(Vcount), arrFinSrfPts(Ucount),finSrfPt(crvSteps)
r=0
For i = 0 To Ucount-1 Step 1
For j = 0 To Vcount-1 Step 1
For k = 0 To objCount Step 1
ctrlCrvPts(k) = arrSrfPts(k)(i)(j)
Next
ctrlCrv = Rhino.AddInterpCurve(ctrlCrvPts)
crvDom = Rhino.CurveDomain(ctrlCrv)
For r = 0 To crvSteps Step 1
finSrfPt(r)= Rhino.EvaluateCurve(ctrlCrv,r*(crvDom(1)/crvSteps))
Next
If crvBln = False Then
Call Rhino.DeleteObject(ctrlCrv)
End If
finSrfSet(j) = finSrfPt
Next
arrFinSrfPts(i) = finSrfSet
Next

‘resequence into point grid for surface
Dim SrfCtrlPts(),endSurf()
ReDim SrfCtrlPts(Vcount*Ucount-1),endSurf(crvSteps)
For i = 0 To crvSteps Step 1
r=0
For j = 0 To Ucount-1 Step 1
For k = 0 To Vcount-1 Step 1
SrfCtrlPts(r) = arrFinSrfPts(j)(k)(i)
r=r+1
Next
Next
endSurf(i) = Rhino.AddSrfControlPtGrid (array(Ucount,Vcount), SrfCtrlPts,array(Udom,Vdom))
Next
Call Rhino.DeleteObjects(surfaces)
surfaceMorpher = endSurf
End Function

Advertisements

arrange.multisweep.01

March.5.2010 - Leave a Response

Option Explicit
‘Script written by
‘Script copyrighted by
‘Script version Thursday, March 13, 2008 4:36:59 PM

Call Main()
Sub Main()
Dim rails,profile,blnOrigin, i
rails = Rhino.GetObjects(“Select Rail Curves”,4)
If isNull(rails) Then Exit Sub
profile = Rhino.GetObjects(“Select Profile Curves in Order of Placement”,4)
If isNull(profile) Then Exit Sub

Dim bbox, tline, tpt, pt, arrPt()
ReDim arrPt(Ubound(profile))
For i = 0 To Ubound(profile) Step 1
Call Rhino.SelectObject(profile(i))
bbox = Rhino.BoundingBox(profile(i))
Call Rhino.EnableRedraw(False)
tline = Rhino.AddLine(bbox(0),bbox(2))
tpt = Rhino.CurveMidPoint(tline)
Call Rhino.DeleteObject(tline)
Call Rhino.EnableRedraw(True)

pt = Rhino.GetPoint(“Select Origin for Profile” & i,tpt)
Call Rhino.Command(“_SelNone”,False)

If isNull(pt) Then
arrPt(i) = tpt
Else
arrPt(i) = pt
End If
pt = Null
Next

Call Rhino.EnableRedraw(False)
For i = 0 To uBound(rails) Step 1
Call reparameterize(rails(i))
Next
Call Rhino.EnableRedraw(True)

Call curveSweepMultiProf(rails,profile,arrPt)
End Sub
Function curveSweepMultiProf(rail,profile,arrOrigin)
curveSweepMultiProf = Null

Dim i,j,k,m,n,angle,pCount,Count
Count = uBound(rail)
pCount = uBound(profile)
‘profile variables
Dim bBox(), oriPts(), dist(2), originPts(2),originPln
ReDim bBox(pCount), oriPts(pCount)

‘create an origin plane for the profile
Call Rhino.EnableRedraw(False)
For j = 0 To pCount Step 1
bBox(j) = Rhino.BoundingBox(profile(j))
dist(0) = Rhino.Distance(bBox(j)(0),bBox(j)(2))
dist(1) = Rhino.Distance(bBox(j)(0),bBox(j)(5))
dist(2) = Rhino.Distance(bBox(j)(0),bBox(j)(7))

If dist(0) > dist(1) And dist(0) > dist(2) Then
m = array(1,0,0)
n = array(0,1,0)
ElseIf dist(1) > dist(0) And dist(1) > dist(2) Then
m = array(1,0,0)
n = array(0,0,1)
ElseIf dist(2) > dist(1) And dist(2) > dist(0) Then
m = array(0,1,0)
n = array(0,0,1)
End If

originPts(2)= arrOrigin(j)
originPts(0)= array(originPts(2)(0)+m(0),originPts(2)(1)+m(1),originPts(2)(2)+m(2))
originPts(1)= array(originPts(2)(0)+n(0),originPts(2)(1)+n(1),originPts(2)(2)+n(2))

originPln = Rhino.PlaneFromPoints(originPts(2),originPts(0),originPts(1))
oriPts(j) = originPts
Next

‘create alignment planes on the curve
‘rail variables
Dim crvDom,crvStep, crvPlane(),crvProf(),crvPt(2)
ReDim crvPlane(Pcount),crvPlaneSet(count),crvProfSet(count),crvProf(Pcount)
For i = 0 To count Step 1
crvDom = Rhino.CurveDomain(rail(i))
If Pcount = 0 Then
crvStep= 0
Else
crvStep= crvDom(1)/Pcount
End If
For j = 0 To Pcount Step 1
crvPlane(j) = Rhino.CurvePerpFrame(rail(i), j*crvStep)
crvPt(0) = crvPlane(j)(0)
crvPt(1) = Rhino.pointadd(crvPlane(j)(0),crvPlane(j)(1))
crvPt(2) = Rhino.pointadd(crvPlane(j)(0),crvPlane(j)(2))
crvProf(j) = Rhino.OrientObject (profile(j), array(oriPts(j)(2),oriPts(j)(1),oriPts(j)(0)),array(crvPt(0),crvPt(1),crvPt(2)),1)
Next
crvPlaneSet(i)= crvPlane
crvProfSet(i) = crvProf
Next
‘allow for rotation correction
Call Rhino.EnableRedraw(True)
angle = 90
Do Until angle = 0
angle = Rhino.GetReal(“Object Rotation”,0,0,360)
If isNull(angle) Then Exit Do
Call Rhino.EnableRedraw(False)
For i = 0 To count Step 1
For j = 0 To Pcount Step 1
Call Rhino.RotateObject(crvProfSet(i)(j),crvPlaneSet(i)(j)(0),angle,crvPlaneSet(i)(j)(3))
Next
Next
Call Rhino.EnableRedraw(True)
Loop

Call Rhino.EnableRedraw(False)

‘sweep variables
Dim swProfSet(),strProfSet
ReDim swProfSet(Pcount)

‘call out sweep command
For i = 0 To count Step 1
For j = 0 To Pcount Step 1
swProfSet(j) = (“_SelID ” & crvProfSet(i)(j) & ” “)
Next
strProfSet = Join(swProfSet)
‘swPprofSet
Call Rhino.Command( “-_Sweep1 ” & “_SelID ” & rail(i) & ” ” & strProfSet & ” _Enter _Enter _Simplify=None Enter”, False)
Next
Call Rhino.EnableRedraw(True)

curveSweepMultiProf = array()
End Function
Function reparameterize(strObjectID)
If Rhino.IsCurve(strObjectID) = True Then
Call rhino.SelectObject(strObjectID)
Call rhino.Command(“reparameterize 0 1”,False)
Call rhino.UnselectAllObjects()
End If
If Rhino.IsSurface(strObjectID) = True Then
Call rhino.SelectObject(strObjectID)
Call rhino.Command(“reparameterize 0 1 0 1”,False)
Call rhino.UnselectAllObjects()
End If
End Function

misc.documentation.arrows.01

March.5.2010 - Leave a Response

Option Explicit
‘Script written by
‘Script copyrighted by
‘Script version Sunday, June 08, 2008 1:19:49 AM

Call Main()
Sub Main()
Dim crv: crv = Rhino.GetObjects(“Select Curves”,4)
If isNull(crv) Then Exit Sub
Dim arrItems, arrValues, arrResults
arrItems = array(“scale_width”,”twist_angle”,”tip_location”,”tip_angle”,”start_width”,”end_width”,”tip_length”,”type_(1)or(2)”,”curved arrows”)
arrValues = array(1,0,.95,45,.2,.5,1,1,True)
arrResults = Rhino.PropertyListBox (arrItems, arrValues ,,”Arrow Parameters”)
Dim i
If arrResults(0) .99 Then
arrResults(2) = .99
End If
If arrResults(4) < .01 Then
arrResults(4) = .01
End If
If arrResults(5) < .01 Then
arrResults(5) = .01
End If
If arrResults(7) 1 Then
arrResults(7) = 1
End If

Call Rhino.EnableRedraw(False)
For i = 0 To uBound(crv) Step 1
Call reparameterize(crv(i))
Call curveArrows(crv(i),CDbl(arrResults(0)),CDbl(arrResults(1)),CDbl(arrResults(2)),CDbl(arrResults(3)),CDbl(arrResults(4)),CDbl(arrResults(5)),CDbl(arrResults(6)),CInt(arrResults(7)),CBool(arrResults(8)))
Next
Call Rhino.EnableRedraw(True)
End Sub
Function curveArrows(curve, dblScale,twistAngle,tip,headAngle,edgeParaA,edgeParaB,width,dblType,CrvBln)
curveArrows = Null
Dim i,j, crv, tipEdge, crvCpy, crvDom, dis,scale, count, crvFrame, strProfSet(1),tempCrv, crvX, srf(3)
Dim endPt, midPtA, midPtB
count = 2+CInt(twistAngle/90)
ReDim frame(count), pt(count*2+1), swProfSetA(count-1), swProfSetB(count-1),crvA(count-1),crvB(count-1),parameter(count)
ReDim srfEdge(2), edgeA(count-1), edgeB(count-1)

If width 0 Then
tip = (Rhino.CurveLength(curve)-width)/Rhino.CurveLength (curve)
End If
crvDom = Rhino.CurveDomain(curve)(1)
parameter(0) = 0
For i = 0 To count-1 Step 1
parameter(i) = (crvDom*tip/(count-1))*i
Next
parameter(count) = crvDom-(crvDom-crvDom*tip)*.5

dis = Rhino.Distance(Rhino.EvaluateCurve(curve,crvDom*tip),Rhino.EvaluateCurve(curve,crvDom))*dblScale
scale = dis*0.5

j=0
For i = 0 To count Step 1
crvFrame = Rhino.CurveFrame(curve,parameter(i))
If i = count Then
frame(i) = Rhino.RotatePlane(crvFrame,(twistAngle/(count-1))*(i-1),crvFrame(1))
Else
frame(i) = Rhino.RotatePlane(crvFrame,(twistAngle/(count-1))*i,crvFrame(1))
End If
pt(j) = Rhino.PointAdd(frame(i)(0),Rhino.VectorRotate(Rhino.VectorScale(frame(i)(2),scale),90-headAngle,frame(i)(3)))
j=j+1
pt(j) = Rhino.PointAdd(frame(i)(0),Rhino.VectorRotate(Rhino.VectorScale(frame(i)(2),scale),90+headAngle,frame(i)(3)))
j=j+1
If iedgeParaB Then
edgeParaB = -(edgeParaA-edgeParaB)/(count-1)
ElseIf edgeParaB>edgeParaA Then
edgeParaB = (edgeParaB-edgeParaA)/(count-1)
Else
edgeParaB = 0
End If
For i = 0 To count-1 Step 1
edgeA(i) = Rhino.SplitCurve(crvA(i),Rhino.CurveDomain(crvA(i))(1)*(1-(edgeParaA+edgeParaB*i)),True)
edgeB(i) = Rhino.SplitCurve(crvB(i),Rhino.CurveDomain(crvB(i))(1)*(edgeParaA+edgeParaB*i),True)
Next
For i = 0 To count-1 Step 1
swProfSetA(i) = (“_SelID ” & edgeA(i)(1) & ” “)
swProfSetB(i) = (“_SelID ” & edgeB(i)(0) & ” “)

Next
strProfSet(0) = Join(swProfSetA)
strProfSet(1) = Join(swProfSetB)
If dblType = 1 Then
Call Rhino.Command( “-_Sweep1 ” & “_SelID ” & crv(0) & ” ” & strProfSet(0) & ” _Enter _Simplify=None Enter”)
srf(2)= Rhino.FirstObject()
End If
Call Rhino.Command( “-_Sweep1 ” & “_SelID ” & crv(0) & ” ” & strProfSet(1) & ” _Enter _Simplify=None Enter”)
srf(3)= Rhino.FirstObject()

If dblType = 1 Then
Call Rhino.JoinSurfaces(srf,True)
Else
Call Rhino.JoinSurfaces(array(srf(1),srf(3)),True)
End If
Call Rhino.DeleteObjects(crv)
Call Rhino.DeleteObjects(srfEdge)
For i = 0 To count-1 Step 1
Call Rhino.DeleteObjects(edgeA(i))
Call Rhino.DeleteObjects(edgeB(i))
Next
End Function
Function reparameterize(strCurveID)
If Rhino.IsCurve(strCurveID) = True Then
Call rhino.SelectObject(strCurveID)
Call rhino.Command(“reparameterize 0 1”)
Call rhino.UnselectAllObjects()
End If
If Rhino.IsSurface(strCurveID) = True Then
Call rhino.SelectObject(strCurveID)
Call rhino.Command(“reparameterize 0 1 0 1”)
Call rhino.UnselectAllObjects()
End If
End Function

geometry.lattice pipe.01

March.5.2010 - Leave a Response

Option Explicit
‘Script written by
‘Script copyrighted by
‘Script version Sunday, August 30, 2009 1:22:47 AM

Call Main()
Sub Main()
Dim strCurve
strCurve = Rhino.GetObject(“Select Curve”,4,True)
If isNull(strCurve) Then Exit Sub
Call reparameterize(strCurve)

Dim arrItems, arrValues, arrReturns
arrItems = array(“Strands”,”Rotations”,”Strand Oscillations”,”Min Radius”,”Max Radius”,”Radius Oscillations”,”Samples”)
arrValues= array(8,0,4,1,2,4,18)
arrReturns = Rhino.PropertyListBox (arrItems, arrValues ,,”Parameters”)
If isNull(arrReturns) Then Exit Sub

Call Rhino.EnableRedraw(False)
Call curveLattice(strCurve,CInt(arrReturns(0)),CInt(arrReturns(2)),CDbl(arrReturns(1)),array(CDbl(arrReturns(3)),CDbl(arrReturns(4))),CInt(arrReturns(5)),CInt(arrReturns(6)))
Call Rhino.EnableRedraw(True)

End Sub
Function curveLattice(strCurve,intStrands,intOscillations, dblRotation, arrRadius, intRadius, intSamples)
curveLattice = Null
intOscillations = intOscillations*2

Dim i,j, count, tDom, tStep, rStep, dblSc
Dim tFrame, rFrame
Dim arrOutput(),arrPt()

count = intSamples*intOscillations
ReDim arrPt(count), arrOutput(intStrands)

tDom = Rhino.CurveDomain(strCurve)
tStep = (tDom(1)-tDom(0))/count
rStep = 360/intStrands
dblSc = arrRadius(1)-arrRadius(0)

For i = 0 To intStrands-1 Step 1
For j = 0 To count Step 1
tFrame = Rhino.CurvePerpFrame(strCurve,tDom(0)+tStep*j)
If i Mod(2) Then
rFrame = Rhino.RotatePlane(tFrame,rStep*i+(rStep*0.5)*sin(intOscillations*PI*(j/count))+(360*dblRotation)*j/count,tFrame(3))
Else
rFrame = Rhino.RotatePlane(tFrame,rStep*i+(rStep*0.5)*sin(PI+intOscillations*PI*(j/count))+(360*dblRotation)*j/count,tFrame(3))
End If
arrPt(j) = Rhino.PointAdd(tFrame(0),Rhino.VectorScale(Rhino.VectorUnitize(rFrame(1)),arrRadius(0)+dblSc+dblSc*cos(intRadius*PI*(j/count))))
Next
arrOutput(i) = arrPt
Call Rhino.AddInterpCurve(arrPt)
Next

curveLattice = arrOutput
End Function
Function reparameterize(strObjectID)
If Rhino.IsCurve(strObjectID) = True Then
Call rhino.SelectObject(strObjectID)
Call rhino.Command(“reparameterize 0 1”)
Call rhino.UnselectAllObjects()
End If
If Rhino.IsSurface(strObjectID) = True Then
Call rhino.SelectObject(strObjectID)
Call rhino.Command(“reparameterize 0 1 0 1”)
Call rhino.UnselectAllObjects()
End If
End Function

images.reader.01

March.5.2010 - Leave a Response

Option Explicit
‘Script written by
‘Script copyrighted by
‘Script version Monday, May 26, 2008 1:43:26 PM

Call Main()
Sub Main()
Dim surf
surf = Rhino.GetObject(“select surface”,8)
If isNull(surf) Then Exit Sub
Call reparameterize(surf)

Dim arrItems, arrValues, arrResults
arrItems = array(“Cell_Colums”,”Cell_Rows”,”Offset”,”Scale_btw_0-1″,”tabHeight”,”cutTemplate”,”surfaces”,”imageScale”,”imageOculi”)
arrValues= array(10,10,1,0.4,1,True,True,False,True)
arrResults = Rhino.PropertyListBox (arrItems, arrValues ,,”Volume Parameters”)
Dim scale, oculi

If CBool(arrResults(7)) = True Then
scale = arrImageSample(CInt(arrResults(0))*2+1, CInt(arrResults(1))*2+1)(6)
Else
scale = arrayValue(CInt(arrResults(0))*2+1, CInt(arrResults(1))*2+1,CDbl(arrResults(2)))
End If
If CBool(arrResults(8)) = True Then
oculi = arrImageSample(CInt(arrResults(0))*2, CInt(arrResults(1))*2)(6)
Else
oculi = arrayValue(CInt(arrResults(0))*2, CInt(arrResults(1))*2,CDbl(arrResults(3)))
End If

Dim tri, cut(2)
Call Rhino.EnableRedraw(False)
tri = TriangulateSurface(surf,CInt(arrResults(0))*2,CInt(arrResults(1))*2,CDbl(arrResults(2)),scale)
If CBool(arrResults(6)) = True Then
Call SurfaceMe(tri(0),oculi,CDbl(arrResults(3)),”surfaces_out”)
Call SurfaceMe(tri(1),oculi,CDbl(arrResults(3)),”surfaces_in”)
Call SurfaceMe(tri(2),oculi,CDbl(arrResults(3)),”surfaces_center”)
End If

If CBool(arrResults(5)) = True Then
cut(0) = UnfoldMe(tri(0),0,CDbl(arrResults(4)),oculi,CDbl(arrResults(3)),”A”)
cut(1) = UnfoldMe(tri(1),cut(0)+5,CDbl(arrResults(4)),oculi,CDbl(arrResults(3)),”B”)
cut(2) = UnfoldMe(tri(2),cut(1)+5,CDbl(arrResults(4)),oculi,CDbl(arrResults(3)),”C”)
End If

Call Rhino.EnableRedraw(True)

End Sub
Function TriangulateSurface(surface,cols,rows,offset,arrOffset)
TriangulateSurface = Null
Dim i,j
Dim uDom,vDom,uStep,vStep
uDom = Rhino.SurfaceDomain(surface,0)(1): uStep = uDom/cols
vDom = Rhino.SurfaceDomain(surface,1)(1): VStep = vDom/rows

ReDim uv(rows),pt(rows),ptA(rows),ptB(rows),uvSet(cols),ptSet(cols),ptSetA(cols),ptSetB(cols)
‘plot point grid
For i = 0 To cols Step 1
For j = 0 To rows Step 1
uv(j) = array(i*uStep,j*vStep)
ptB(j) = Rhino.EvaluateSurface(surface,uv(j))
If arrOffset(i)(j) 0.9 Then
If i Mod(2) Then
If j Mod(2) Then
srfA(j) = Rhino.AddSrfPt(array(ptSet(i)(j),ptSet(i)(j+1),ptSet(i+1)(j)))
srfB(j) = Rhino.AddSrfPt(array(ptSet(i+1)(j+1),ptSet(i)(j+1),ptSet(i+1)(j)))
Else
srfA(j) = Rhino.AddSrfPt(array(ptSet(i+1)(j),ptSet(i+1)(j+1),ptSet(i)(j)))
srfB(j) = Rhino.AddSrfPt(array(ptSet(i)(j+1),ptSet(i+1)(j+1),ptSet(i)(j)))
End If
Else
If j Mod(2) Then
srfA(j) = Rhino.AddSrfPt(array(ptSet(i+1)(j),ptSet(i+1)(j+1),ptSet(i)(j)))
srfB(j) = Rhino.AddSrfPt(array(ptSet(i)(j+1),ptSet(i+1)(j+1),ptSet(i)(j)))
Else
srfA(j) = Rhino.AddSrfPt(array(ptSet(i)(j),ptSet(i)(j+1),ptSet(i+1)(j)))
srfB(j) = Rhino.AddSrfPt(array(ptSet(i+1)(j+1),ptSet(i)(j+1),ptSet(i+1)(j)))
End If
End If
Call Rhino.ObjectLayer(srfA(j),objLayer)
Call Rhino.ObjectLayer(srfB(j),objLayer)
Else
If scale(i)(j) ptC(j-1)(1) Then
angX(j) = -Rhino.Angle2(array(ptB(j-1),Rhino.PointAdd(ptB(j-1),wrldCS(1))),array(ptB(j-1),ptC(j-1)))(0)
Else
angX(j) = Rhino.Angle2(array(ptB(j-1),Rhino.PointAdd(ptB(j-1),wrldCS(1))),array(ptB(j-1),ptC(j-1)))(0)
End If
End If
If i Mod(2) Then
r = j+1
Else
r = j
End If
If r Mod(2) Then
ptA(j) = Rhino.PointAdd(oriPt(j),Rhino.VectorScale(Rhino.VectorRotate(wrldCS(1),angX(j),wrldCS(3)),d(i)(0)(j)))
ptB(j) = Rhino.PointAdd(oriPt(j),Rhino.VectorScale(Rhino.VectorRotate(wrldCS(1),angX(j)+a(i)(1)(j)+a(i)(2)(j),wrldCS(3)),d(i)(2)(j)))
ptC(j) = Rhino.PointAdd(ptA(j),Rhino.VectorScale(Rhino.VectorRotate(wrldCS(1),angX(j)+180-a(i)(0)(j),wrldCS(3)),d(i)(1)(j)))
Else
ptA(j) = Rhino.PointAdd(oriPt(j),Rhino.VectorScale(Rhino.VectorRotate(wrldCS(1),angX(j),wrldCS(3)),d(i)(0)(j)))
ptB(j) = Rhino.PointAdd(oriPt(j),Rhino.VectorScale(Rhino.VectorRotate(wrldCS(1),angX(j)+a(i)(0)(j),wrldCS(3)),d(i)(1)(j)))
ptC(j) = Rhino.PointAdd(ptA(j),Rhino.VectorScale(Rhino.VectorRotate(wrldCS(1),angX(j)+180-a(i)(1)(j)-a(i)(2)(j),wrldCS(3)),d(i)(2)(j)))
End If
minX(j) = Rhino.Min(array(ptA(j)(0),ptB(j)(0),ptC(j)(0)))
maxX(j) = Rhino.Max(array(ptA(j)(0),ptB(j)(0),ptC(j)(0)))
r=r+1
Next
mn(i) = Rhino.Min(minX)
If mn(i) > 0 Then
mn(i) = 0
Else
mn(i) = abs(mn(i))
End If
mx(i) = abs(Rhino.Max(maxX))
pts(i) = array(oriPt,ptA,ptB,ptC)
Next
Dim ptX, k,u
Dim points(3),yVal(3),dblY
ReDim yMax(rows-1), yM(cols-1)
Dim edge(),edgeA(), edgeB(), span()
ReDim edge(cols-1),edgeA(rows-1), edgeB(rows-1), span(rows*2)
Dim cPt(1), oculi(1)
r=0
For i = 0 To cols-1 Step 1
k=0
If i > 0 Then
r = r+mx(i-1)+mn(i)+tabHeight*2
End If
For j = 0 To rows-1 Step 1
ptX = array(r,0,0)
For u = 0 To 3 Step 1
points(u) = Rhino.PointAdd(ptX,pts(i)(u)(j))
Next
If j Mod(2) Then
span(k) = Rhino.AddLine(points(0),points(3))
Call Rhino.ObjectLayer(span(k),”scores”)
k=k+1
Else
span(k) = Rhino.AddLine(points(1),points(2))
Call Rhino.ObjectLayer(span(k),”scores”)
k=k+1
End If
If j = 0 Then
span(k) = Rhino.AddLine(points(0),points(1))
Call Rhino.ObjectLayer(span(k),”cuts”)
k=k+1
End If
If j = rows-1 Then
span(k) = Rhino.AddLine(points(2),points(3))
Call Rhino.ObjectLayer(span(k),”cuts”)
k=k+1
Else
span(k) = Rhino.AddLine(points(2),points(3))
Call Rhino.ObjectLayer(span(k),”scores”)
k=k+1
End If

If scale(i)(j) <= .9 Then
If scale(i)(j) w Then
x = w
End If

If y>h Then
y = h
End If

r(j) = RhPicture.Red(x,y)/255
g(j) = RhPicture.Green(x,y)/255
b(j) = RhPicture.Blue(x,y)/255
a(j) = RhPicture.Alpha(x,y)/255
hu(j) = RhPicture.Hue(x,y)/360
s(j) = RhPicture.Saturation(x,y)
u(j) = RhPicture.Luminance(x,y)

Next
rValSet(i) = r
gValSet(i) = g
bValSet(i) = b
aValSet(i) = a
hValSet(i) = hu
sValSet(i) = s
uValSet(i) = u
Next
Set RhPicture = Nothing
‘ image outputs (0)red(1)green(2)blue(3)alpha(4)hue(5)saturation(6)luminance
arrImageSample = array(rValSet,gValSet,bValSet,aValSet,hValSet,sValSet,uValSet)
End Function
Function arrayValue(cols,rows,value)
arrayValue = Null
Dim i,j
ReDim val(rows), arrVal(cols)
For i = 0 To cols Step 1
For j = 0 To rows Step 1
val(j) = value
Next
arrVal(i) = val
Next
arrayValue = arrVal
End Function

surfaces.expand.01

March.5.2010 - Leave a Response

Option Explicit
‘Script written by
‘Script copyrighted by
‘Script version Monday, May 26, 2008 1:43:26 PM

Call Main()
Sub Main()
Dim surf
surf = Rhino.GetObject(“select surface”,8)
If isNull(surf) Then Exit Sub
Call reparameterize(surf)

Dim arrItems, arrValues, arrResults
arrItems = array(“Cell_Colums”,”Cell_Rows”,”Offset”,”Scale_btw_0-1″,”tabHeight”,”cutTemplate”,”surfaces”,”imageScale”,”imageOculi”)
arrValues= array(10,10,1,0.4,1,True,True,False,True)
arrResults = Rhino.PropertyListBox (arrItems, arrValues ,,”Volume Parameters”)
Dim scale, oculi

If CBool(arrResults(7)) = True Then
scale = arrImageSample(CInt(arrResults(0))*2+1, CInt(arrResults(1))*2+1)(6)
Else
scale = arrayValue(CInt(arrResults(0))*2+1, CInt(arrResults(1))*2+1,CDbl(arrResults(2)))
End If
If CBool(arrResults(8)) = True Then
oculi = arrImageSample(CInt(arrResults(0))*2, CInt(arrResults(1))*2)(6)
Else
oculi = arrayValue(CInt(arrResults(0))*2, CInt(arrResults(1))*2,CDbl(arrResults(3)))
End If

Dim tri, cut(2)
Call Rhino.EnableRedraw(False)
tri = TriangulateSurface(surf,CInt(arrResults(0))*2,CInt(arrResults(1))*2,CDbl(arrResults(2)),scale)
If CBool(arrResults(6)) = True Then
Call SurfaceMe(tri(0),oculi,CDbl(arrResults(3)),”surfaces_out”)
Call SurfaceMe(tri(1),oculi,CDbl(arrResults(3)),”surfaces_in”)
Call SurfaceMe(tri(2),oculi,CDbl(arrResults(3)),”surfaces_center”)
End If

If CBool(arrResults(5)) = True Then
cut(0) = UnfoldMe(tri(0),0,CDbl(arrResults(4)),oculi,CDbl(arrResults(3)),”A”)
cut(1) = UnfoldMe(tri(1),cut(0)+5,CDbl(arrResults(4)),oculi,CDbl(arrResults(3)),”B”)
cut(2) = UnfoldMe(tri(2),cut(1)+5,CDbl(arrResults(4)),oculi,CDbl(arrResults(3)),”C”)
End If

Call Rhino.EnableRedraw(True)

End Sub
Function TriangulateSurface(surface,cols,rows,offset,arrOffset)
TriangulateSurface = Null
Dim i,j
Dim uDom,vDom,uStep,vStep
uDom = Rhino.SurfaceDomain(surface,0)(1): uStep = uDom/cols
vDom = Rhino.SurfaceDomain(surface,1)(1): VStep = vDom/rows

ReDim uv(rows),pt(rows),ptA(rows),ptB(rows),uvSet(cols),ptSet(cols),ptSetA(cols),ptSetB(cols)
‘plot point grid
For i = 0 To cols Step 1
For j = 0 To rows Step 1
uv(j) = array(i*uStep,j*vStep)
ptB(j) = Rhino.EvaluateSurface(surface,uv(j))
If arrOffset(i)(j) 0.9 Then
If i Mod(2) Then
If j Mod(2) Then
srfA(j) = Rhino.AddSrfPt(array(ptSet(i)(j),ptSet(i)(j+1),ptSet(i+1)(j)))
srfB(j) = Rhino.AddSrfPt(array(ptSet(i+1)(j+1),ptSet(i)(j+1),ptSet(i+1)(j)))
Else
srfA(j) = Rhino.AddSrfPt(array(ptSet(i+1)(j),ptSet(i+1)(j+1),ptSet(i)(j)))
srfB(j) = Rhino.AddSrfPt(array(ptSet(i)(j+1),ptSet(i+1)(j+1),ptSet(i)(j)))
End If
Else
If j Mod(2) Then
srfA(j) = Rhino.AddSrfPt(array(ptSet(i+1)(j),ptSet(i+1)(j+1),ptSet(i)(j)))
srfB(j) = Rhino.AddSrfPt(array(ptSet(i)(j+1),ptSet(i+1)(j+1),ptSet(i)(j)))
Else
srfA(j) = Rhino.AddSrfPt(array(ptSet(i)(j),ptSet(i)(j+1),ptSet(i+1)(j)))
srfB(j) = Rhino.AddSrfPt(array(ptSet(i+1)(j+1),ptSet(i)(j+1),ptSet(i+1)(j)))
End If
End If
Call Rhino.ObjectLayer(srfA(j),objLayer)
Call Rhino.ObjectLayer(srfB(j),objLayer)
Else
If scale(i)(j) ptC(j-1)(1) Then
angX(j) = -Rhino.Angle2(array(ptB(j-1),Rhino.PointAdd(ptB(j-1),wrldCS(1))),array(ptB(j-1),ptC(j-1)))(0)
Else
angX(j) = Rhino.Angle2(array(ptB(j-1),Rhino.PointAdd(ptB(j-1),wrldCS(1))),array(ptB(j-1),ptC(j-1)))(0)
End If
End If
If i Mod(2) Then
r = j+1
Else
r = j
End If
If r Mod(2) Then
ptA(j) = Rhino.PointAdd(oriPt(j),Rhino.VectorScale(Rhino.VectorRotate(wrldCS(1),angX(j),wrldCS(3)),d(i)(0)(j)))
ptB(j) = Rhino.PointAdd(oriPt(j),Rhino.VectorScale(Rhino.VectorRotate(wrldCS(1),angX(j)+a(i)(1)(j)+a(i)(2)(j),wrldCS(3)),d(i)(2)(j)))
ptC(j) = Rhino.PointAdd(ptA(j),Rhino.VectorScale(Rhino.VectorRotate(wrldCS(1),angX(j)+180-a(i)(0)(j),wrldCS(3)),d(i)(1)(j)))
Else
ptA(j) = Rhino.PointAdd(oriPt(j),Rhino.VectorScale(Rhino.VectorRotate(wrldCS(1),angX(j),wrldCS(3)),d(i)(0)(j)))
ptB(j) = Rhino.PointAdd(oriPt(j),Rhino.VectorScale(Rhino.VectorRotate(wrldCS(1),angX(j)+a(i)(0)(j),wrldCS(3)),d(i)(1)(j)))
ptC(j) = Rhino.PointAdd(ptA(j),Rhino.VectorScale(Rhino.VectorRotate(wrldCS(1),angX(j)+180-a(i)(1)(j)-a(i)(2)(j),wrldCS(3)),d(i)(2)(j)))
End If
minX(j) = Rhino.Min(array(ptA(j)(0),ptB(j)(0),ptC(j)(0)))
maxX(j) = Rhino.Max(array(ptA(j)(0),ptB(j)(0),ptC(j)(0)))
r=r+1
Next
mn(i) = Rhino.Min(minX)
If mn(i) > 0 Then
mn(i) = 0
Else
mn(i) = abs(mn(i))
End If
mx(i) = abs(Rhino.Max(maxX))
pts(i) = array(oriPt,ptA,ptB,ptC)
Next
Dim ptX, k,u
Dim points(3),yVal(3),dblY
ReDim yMax(rows-1), yM(cols-1)
Dim edge(),edgeA(), edgeB(), span()
ReDim edge(cols-1),edgeA(rows-1), edgeB(rows-1), span(rows*2)
Dim cPt(1), oculi(1)
r=0
For i = 0 To cols-1 Step 1
k=0
If i > 0 Then
r = r+mx(i-1)+mn(i)+tabHeight*2
End If
For j = 0 To rows-1 Step 1
ptX = array(r,0,0)
For u = 0 To 3 Step 1
points(u) = Rhino.PointAdd(ptX,pts(i)(u)(j))
Next
If j Mod(2) Then
span(k) = Rhino.AddLine(points(0),points(3))
Call Rhino.ObjectLayer(span(k),”scores”)
k=k+1
Else
span(k) = Rhino.AddLine(points(1),points(2))
Call Rhino.ObjectLayer(span(k),”scores”)
k=k+1
End If
If j = 0 Then
span(k) = Rhino.AddLine(points(0),points(1))
Call Rhino.ObjectLayer(span(k),”cuts”)
k=k+1
End If
If j = rows-1 Then
span(k) = Rhino.AddLine(points(2),points(3))
Call Rhino.ObjectLayer(span(k),”cuts”)
k=k+1
Else
span(k) = Rhino.AddLine(points(2),points(3))
Call Rhino.ObjectLayer(span(k),”scores”)
k=k+1
End If

If scale(i)(j) <= .9 Then
If scale(i)(j) w Then
x = w
End If

If y>h Then
y = h
End If

r(j) = RhPicture.Red(x,y)/255
g(j) = RhPicture.Green(x,y)/255
b(j) = RhPicture.Blue(x,y)/255
a(j) = RhPicture.Alpha(x,y)/255
hu(j) = RhPicture.Hue(x,y)/360
s(j) = RhPicture.Saturation(x,y)
u(j) = RhPicture.Luminance(x,y)

Next
rValSet(i) = r
gValSet(i) = g
bValSet(i) = b
aValSet(i) = a
hValSet(i) = hu
sValSet(i) = s
uValSet(i) = u
Next
Set RhPicture = Nothing
‘ image outputs (0)red(1)green(2)blue(3)alpha(4)hue(5)saturation(6)luminance
arrImageSample = array(rValSet,gValSet,bValSet,aValSet,hValSet,sValSet,uValSet)
End Function
Function arrayValue(cols,rows,value)
arrayValue = Null
Dim i,j
ReDim val(rows), arrVal(cols)
For i = 0 To cols Step 1
For j = 0 To rows Step 1
val(j) = value
Next
arrVal(i) = val
Next
arrayValue = arrVal
End Function

misc.documentation

March.5.2010 - Leave a Response

Option Explicit
‘Script written by
‘Script copyrighted by
‘Script version Sunday, September 28, 2008 12:18:06 AM

Call Main()
Sub Main()
Dim objects, folder, name, arrResults, arrDrawings
objects = Rhino.GetObjects(“Select Objects”)
If isNull(objects) Then Exit Sub

arrDrawings = Rhino.GetBoolean(“DrawingTypes”, array(“orthoElev”,”no”,”yes”,”auxElev”,”no”,”yes”,”auxTop”,”no”,”yes”,”auxBottom”,”no”,”yes”,”isoTop”,”no”,”yes”,”isoBottom”,”no”,”yes”),array(True,False,False,False,False,True))

arrResults = Rhino.GetBoolean(“Output Options”, array(“drawings”,”no”,”yes”,”renders”,”no”,”yes”),array(True,False))

If arrResults(1) = True Then
name=Rhino.GetString(“Enter prefix for jpeg file naming”)
folder = Rhino.BrowseForFolder(“testFolder”,”SelectFolder”,”RenderFolder”)
If IsNull(folder) Then Exit Sub
End If

Call multiIso(objects,array(0,0,0),folder,name,arrResults, arrDrawings)
End Sub
Function multiIso(arrObjects, origin,folder,name, arrBool, arrMode)
multiIso = Null

Dim strView
Dim k: k=0
Dim count
Dim arrPoint(),arrTitle()
ReDim arrPoint(k),arrTitle(k)
If arrMode(0) = True Then
ReDim Preserve arrPoint(k+5),arrTitle(k+5),arrSwitch(k+5)
‘plans and elevations
arrTitle(k) = “Top”
arrPoint(k) = Array(0,0,1)
arrTitle(k+1) = “Bottom”
arrPoint(k+1) = Array(0,0,-1)
arrTitle(k+2) = “Front”
arrPoint(k+2) = Array(0,-1,0)
arrTitle(k+3) = “Back”
arrPoint(k+3) = Array( 0,1,0)
arrTitle(k+4) = “Left”
arrPoint(k+4) = Array(-1,0,0)
arrTitle(k+5) = “Right”
arrPoint(k+5) = Array(1,0,0)
k=k+5
End If
If arrMode(1) = True Then
ReDim Preserve arrPoint(k+4),arrTitle(k+4),arrSwitch(k+4)
‘auxilary orthographic elevation
arrSwitch(k) = True
arrTitle(k) = “FrontLeft”
arrPoint(k) = Array(-1,-1,0)
arrTitle(k+1) = “FrontRight”
arrPoint(k+1) = Array( 1,-1,0)
arrTitle(k+2) = “BackLeft”
arrPoint(k+2) = Array(-1, 1,0)
arrTitle(k+3) = “BackRight”
arrPoint(k+3) = Array( 1, 1,0)
k=k+4
End If

If arrMode(2) = True Then
ReDim Preserve arrPoint(k+4),arrTitle(k+4),arrSwitch(k+4)
‘auxilary orthographic top
arrSwitch(k) = True
arrTitle(k) = “TopFront”
arrPoint(k) = Array(0,-1,1)
arrTitle(k+1) = “TopBack”
arrPoint(k+1) = Array( 0,1,1)
arrTitle(k+2) = “TopLeft”
arrPoint(k+2) = Array(-1,0,1)
arrTitle(k+3) = “TopRight”
arrPoint(k+3) = Array( 1,0,1)
k=k+4
End If
If arrMode(3) = True Then
ReDim Preserve arrPoint(k+4),arrTitle(k+4),arrSwitch(k+4)
‘auxilary orthographic bottom
arrSwitch(k) = True
arrTitle(k) = “BottomFront”
arrPoint(k) = Array(0,-1,-1)
arrTitle(k+1) = “BottomBack”
arrPoint(k+1) = Array( 0,1,-1)
arrTitle(k+2) = “BottomLeft”
arrPoint(k+2) = Array(-1,0,-1)
arrTitle(k+3) = “BottomRight”
arrPoint(k+3) = Array( 1,0,-1)
k=k+4
End If
If arrMode(4) = True Then
ReDim Preserve arrPoint(k+4),arrTitle(k+4),arrSwitch(k+4)
‘axonometric isometric top
arrSwitch(k) = True
arrTitle(k) = “TopFrontLeft”
arrPoint(k) = Array(-1,-1,1)
arrTitle(k+1) = “TopFrontRight”
arrPoint(k+1) = Array( 1,-1,1)
arrTitle(k+2) = “TopBackLeft”
arrPoint(k+2) = Array(-1, 1,1)
arrTitle(k+3) = “TopBackRight”
arrPoint(k+3) = Array( 1, 1,1)
k=k+4
End If
If arrMode(5) = True Then
ReDim Preserve arrPoint(k+4),arrTitle(k+4),arrSwitch(k+4)
‘axonometric isometric bottom
arrSwitch(k) = True
arrTitle(k) = “BottomFrontLeft”
arrPoint(k) = Array(-1,-1,-1)
arrTitle(k+1) = “BottomFrontRight”
arrPoint(k+1) = Array( 1,-1,-1)
arrTitle(k+2) = “BottomBackLeft”
arrPoint(k+2) = Array(-1, 1,-1)
arrTitle(k+3) = “BottomBackRight”
arrPoint(k+3) = Array( 1, 1,-1)
k=k+4
End If

count = k-1
Dim arrOrigin, vect
arrOrigin = Array(0,0,0)

Call Rhino.Command(“-_SetView c t “, False)
strView = Rhino.CurrentView()
Dim j,m,n,u
u=0
Dim obox: obox = Rhino.BoundingBox(arrObjects)
Dim i,r,s,t
Dim arrLabel
Dim invSel
Dim arrDrawings(),bbox(), dblLength(), dblHeight(), dblDist
ReDim arrDrawings(count),bbox(count), dblLength(count), dblHeight(count)
Call Rhino.EnableRedraw (False)

If arrBool(0) = True Then
If j = 0 And m = 0 And n = 0 Then
Call Rhino.SelectObjects(arrObjects)
Call Rhino.Command(“-_Make2d ” ,False)
Call Rhino.DeleteObjects(Rhino.SelectedObjects())
Else
Call Rhino.Command(“-_SetView c t “, False)
End If

Call Rhino.ViewProjection(strView,1)
For i = 0 To count Step 1
Call Rhino.ViewCameraTarget (strView, arrPoint(i), arrOrigin)
Call Rhino.UnselectAllObjects()
Call Rhino.SelectObjects(arrObjects)
Call Rhino.ZoomSelected()
Call Rhino.Command(“-_Make2d d c _Enter” ,False)
arrDrawings(i) = Rhino.SelectedObjects()
bbox(i) = Rhino.BoundingBox(arrDrawings(i))
dblLength(i) = Rhino.Distance(bbox(i)(0),bbox(i)(1))
dblHeight(i) = Rhino.Distance(bbox(i)(0),bbox(i)(3))
Call Rhino.UnselectAllObjects()

Next
r = 0
s = 0
t = 0
For i = 0 To count Step 1
ReDim Preserve arrHeight(s)
arrHeight(s) = dblHeight(i)
s=s+1
If arrSwitch(i) = True Then
t = t+Rhino.max(arrHeight)+3
ReDim arrHeight(0)
s = 0
r = 0
End If
If r > 0 Then
r = dblLength(i)*0.5+dblLength(i-1)*0.5+r
End If
Call Rhino.MoveObjects(arrDrawings(i),origin,array(r,u+t,0))
Call Rhino.AddText(CStr(arrTitle(i)),array(r,u+t-dblHeight(i)*0.2,0),dblHeight(i)*0.1)
r=r+3
If i = count Then
t = t+dblHeight(i)*1.5
End If
Next
End If

If arrBool(1) = True Then
If isArray(arrObjects) Then
Call Rhino.SelectObjects(arrObjects)
Else
Call Rhino.SelectObject(arrObjects)
End If
invSel = Rhino.InvertSelectedObjects()
If isNull(invSel) Then
Else
Call Rhino.HideObjects(invSel)
End If
Call Rhino.UnselectAllObjects()

Call Rhino.Command(“-_SetView c t “, False)
For i = 0 To count Step 1
Call Rhino.ViewCameraTarget (strView, arrPoint(i), arrOrigin)
Call Rhino.SelectObjects(arrObjects)
Call Rhino.ZoomSelected()
Call Rhino.Command(“_-Render”,False)
Call Rhino.Command(“_-SaveRenderWindowAs ” & GetRenderFileName(name,folder, CStr(arrTitle(i)), “png”),False)
Call Rhino.Command(“_-CloseRenderWindow”,False)
Call Rhino.UnselectAllObjects()
Next
End If
Call Rhino.EnableRedraw (True)
Call Rhino.Command(“-_SetView c t”, False)
Call Rhino.Command(“-_Show _Enter”,False)
Call Rhino.ZoomExtents()
End Function
Function GetRenderFileName(name,folder, view, ext)
Dim doc, file, temp
doc = Rhino.DocumentName
temp = “_”& name &”_”& view & “.” & ext
file = LCase(Replace(doc, “.3dm”, temp, 1, -1, 1))
GetRenderFileName = Chr(34) & folder & file & Chr(34)
End Function

curves.blend.01

March.5.2010 - Leave a Response

Option Explicit
‘Script written by
‘Script copyrighted by
‘Script version Sunday, May 03, 2009 1:54:38 PM

Call Main()
Sub Main()
Dim Curves, SM, DN

Curves= Rhino.GetObjects(“Select Curves”,4)
If isNull(Curves) Then Exit Sub

SM = Rhino.GetBoolean(“Blend Type”,array(“Type”,”Straight”,”Smooth”),array(False))
If isNull(SM) Then Exit Sub

DN = Rhino.GetReal(“Blend Density”,5,1)
If isNull(SM) Then Exit Sub

Call Rhino.EnableRedraw(False)
If uBound(Curves) > 0 Then
Call BlendCurves(Curves,SM(0),DN)
Else
Call Rhino.Print(“2 or more curves required”)
End If

Call Rhino.EnableRedraw(True)
End Sub
Function BlendCurves(arrCurves,blnSmooth,dblDensity)
BlendCurves = Null
Dim i,j,p
Dim count, max, dMax
Dim arrptCount(), arrCrvDeg(), arrPointSet(),arrPts(), arrCrvDom(),arrCrvStep(),arrBlndCrvPt()
Dim arrBlendCurve(), arrCtrlCrv()

Dim dblSmoothness
If blnSmooth = False Then
dblSmoothness = 1
Else
dblSmoothness = 3
End If

count = Ubound(arrCurves)
ReDim arrptCount(count), arrCrvDeg(count), arrCrvDom(count), arrPointSet(count), arrPts(count)

‘get control point count
For i = 0 To count Step 1
arrptCount(i) = Rhino.CurvePointCount(arrCurves(i))
arrCrvDeg(i) = Rhino.CurveDegree(arrCurves(i))
Next
‘determine max point count
max = Rhino.Max(arrptCount)
dMax= Rhino.Max(arrCrvDeg)

‘rebuild curves with max control point count
For i = 0 To count Step 1
Call Rhino.RebuildCurve(arrCurves(i),dMax, max)
arrPointSet(i) = Rhino.CurvePoints(arrCurves(i))
Next

max = max-1
ReDim arrCtrlCrv(max), arrCrvDom(max), arrCrvStep(max), arrBlndCrvPt(max)
‘create control curves
For i = 0 To max Step 1
For j = 0 To count Step 1
arrPts(j) = arrPointSet(j)(i)
Next
arrCtrlCrv(i)= Rhino.AddInterpCurve(arrPts,dblSmoothness)
arrCrvDom(i) = Rhino.CurveDomain(arrCtrlCrv(i))
arrCrvStep(i)= (arrCrvDom(i)(1)-arrCrvDom(i)(0))/(count*dblDensity)
Next
‘create blended curves
ReDim arrBlendCurve(count*dblDensity)
For i = 0 To count*dblDensity Step 1
For j = 0 To max Step 1
arrBlndCrvPt(j) = Rhino.EvaluateCurve(arrCtrlCrv(j),arrCrvDom(j)(0)+i*arrCrvStep(j))
Next
arrBlendCurve(i) = Rhino.addcurve(arrBlndCrvPt,dMax)
Next
‘delete control curves
Call Rhino.DeleteObjects(arrCtrlCrv)
Call Rhino.DeleteObjects(arrCurves)

BlendCurves = array(arrBlendCurve,arrCtrlCrv)
End Function

curves.bezier.01

March.5.2010 - Leave a Response

Option Explicit
‘Script written by
‘Script copyrighted by
‘Script version Tuesday, July 21, 2009 7:50:34 PM

Call Main()
Sub Main()
Dim arrPoints,intSamples
Do
arrPoints = Rhino.GetObjects(“Select at Least 3 Points”,1,,True)
If isNull(arrPoints) Then Exit Sub

If uBound(arrPoints) > 1 Then
Exit Do
End If
Loop
intSamples = Rhino.GetReal(“Samples”,10,1)
If isNull(intSamples) Then Exit Sub

Dim i, arrPts(),arrOutput
ReDim arrPts(uBound(arrPoints))
For i = 0 To uBound(arrPoints) Step 1
arrPts(i) = Rhino.PointCoordinates(arrPoints(i))
Next

Call Rhino.EnableRedraw(False)
arrOutput = bezierConstructor(arrPts,intSamples)
Call Rhino.AddInterpCurve(arrOutput(0))
Call Rhino.ObjectColor(arrOutput(1),RGB(255,0,0))
Call Rhino.EnableRedraw(True)

End Sub
Function bezierConstructor(arrPts,intSamples)
bezierConstructor = Null
Dim i, j, k, r, s, t
Dim arrOutput(), arrOutputs(), arrStore, arrTemp, arrLines(),arrSet()
r = 0
k=1
ReDim arrOutput(0),arrOutputs(0)
arrOutput(0) = arrPts(0)

For i = 1 To uBound(arrPts) Step 1
ReDim Preserve arrLines(r),arrOutputs(r)
arrLines(r) = Rhino.AddLine(arrPts(i-1),arrPts(i))
arrOutputs(r) = arrLines(r)
r=r+1
Next
t=r
arrStore = arrLines
For i = 1 To intSamples-1 Step 1
r=0
s=0
arrTemp = arrStore
Do
If r = 1 Then
ReDim Preserve arrOutput(k)
arrOutput(k) = curveParameter(arrTemp(0),i*(1/intSamples))
k=k+1
Exit Do
End If
r=0
ReDim Preserve arrSet(s)
arrSet(s) = arrTemp
ReDim arrLines(0)
For j = 1 To ubound(arrSet(s)) Step 1
ReDim Preserve arrLines(r), arrOutputs(t)
arrLines(r) = Rhino.AddLine(curveParameter(arrSet(s)(j-1),i*(1/intSamples)),curveParameter(arrSet(s)(j),i*(1/intSamples)))
arrOutputs(t) = arrLines(r)
t=t+1
r=r+1
Next
arrTemp = arrLines
s=s+1
Loop
Next
ReDim Preserve arrOutput(k)
arrOutput(k) = arrPts(uBound(arrPts))
bezierConstructor = array(arrOutput,arrOutputs)
End Function
Function curveParameter(strCurve,dblParameter)
curveParameter = Null
Dim cDom,arrPoint
cDom = Rhino.CurveDomain(strCurve)
arrPoint = Rhino.EvaluateCurve(strCurve,cDom(0)+dblParameter*(cDom(1)-cDom(0)))
curveParameter = arrPoint
End Function

import.excel.02

February.6.2010 - 2 Responses

Option Explicit

‘excel import to rhinoscript , che-wei wang 4.8.2008
‘excel cell numbers begin with 1,1 (not 0,0)

Call Main()
Sub Main()
Dim FileName, file, excel
FileName = Rhino.OpenFileName(“Select Excel File”,”Excel Files (*.xls)|*.xls||”)
If isNull(FileName) Then Exit Sub

Set excel = CreateObject(“Excel.Application”)
excel.Visible = True

excel.Workbooks.Open(FileName)
Set file = excel.ActiveSheet
Dim i
Dim value(2)
Dim arrPoints(99) ’array is zero based
For i = 1 To 100
value(0) = file.Cells(i,1).Value ’excel file is not zero based
value(1) = file.Cells(i,2).Value
value(2) = file.Cells(i,3).Value
arrPoints(i-1) = rhino.addPoint (value)
Next

Dim arrPoint1, arrPoint2, arrPoint3
Dim strPoint1, strPoint2
For Each strPoint1 In arrPoints
arrPoint1 = rhino.PointCoordinates(strPoint1)
For Each strPoint2 In arrPoints
arrPoint2 = rhino.PointCoordinates(strPoint2)
arrPoint3 = array(arrPoint1, arrPoint2)
rhino.AddCurve arrPoint3
Next
Next

excel.UserControl = True
End Sub