(n)certainties – Columbia – Fall 2008

Bound to the ground (2)

October 8, 2008 · Leave a Comment

Option Explicit
‘Script written by
‘Script copyrighted by
‘Script version domingo, 05 de octubre de 2008 20:28:50

Call Main()
Sub Main()
Dim strCrv, bbox, strBBCrv
strCrv = Rhino.GetObject(“Curve”, 4)
If isNull (strCrv) Then Exit Sub
bbox = Rhino.BoundingBox(strCrv)
strBBCrv = Rhino.AddPolyline (array(bbox(0),bbox(1),bbox(2),bbox(3),bbox(0)))

Dim radius, centBBPt, centPtCrv
centBBPt = Rhino.CurveAreaCentroid(strBBCrv)(0)
centPtCrv = Rhino.CurveAreaCentroid(strCrv)(0)
radius = Rhino.Distance(centBBPt,bbox(0))
Rhino.Print “radius” & radius

Dim arrItems, arrBoolean, blnVal
arrItems = array(“Stepmode”,”Steps”,”Width”)
arrBoolean = Rhino.GetBoolean(“Select mode of population”,arrItems,array(True))

Dim steps, width, n
For Each blnVal In arrBoolean
If blnVal = True Then
steps = Rhino.GetInteger(“Number of steps for machine”,10)
n = steps
Else
width = Rhino.GetReal(“Width of the machine”)
n = CInt(radius/width)
End If
Rhino.Print n
Next

Dim Rad, crvDomain, t, m, i, p, crvCurvature
Dim crvPt()
‘Rhino.AddLine centBBPt,array((bbox(0)(0)+bbox(1)(0))/2,(bbox(0)(1)+bbox(1)(1))/2 ,(bbox(0)(2)+bbox(1)(2))/2 )
Rad = Rhino.AddLine(centBBPt,bbox(0))
Dim arrPlane, circ(), arrPts(),arrPtsCoord(), arrPtsCrv(), a, arrCCX()
arrPlane = Rhino.PlaneFromFrame(centBBPt,array(1,0,0),array(0,1,0))

m=-1
crvDomain = Rhino.CurveDomain(Rad)
For t = crvDomain(0) To crvDomain(1)+1e-9 Step (crvDomain(1)-crvDomain(0))/n
m=m+1
crvCurvature = Rhino.CurveCurvature(Rad, t)
If isNull (crvCurvature) Then
ReDim Preserve crvPt(m)
crvPt(m) = Rhino.EvaluateCurve (Rad,t)

‘——————————————————————
‘IS THERE ANY WAY OF NOT REPEATING ALL THESE???
radius = CDbl(Rhino.Distance(centBBPt,crvPt(m)))
If radius < 1 Then
radius = 1
End If

Rhino.Print “radius :” & radius

p = -1
For a=0 To 2*PI +1e-9 Step PI/8
p = p+1
ReDim Preserve arrPts(p)
arrPts(p) = Rhino.AddPoint(array(radius*sin(a)+centPtCrv(0),radius*cos(a)+centPtCrv(1),centPtCrv(2)))
ReDim Preserve arrPtsCoord(p)
arrPtsCoord(p) = Rhino.PointCoordinates(arrPts(p))
Next

Rhino.DeleteObjects arrPts
Rhino.AddPoint crvPt(m)

ReDim Preserve arrPtsCrv(m)
arrPtsCrv(m) = arrPtsCoord
ReDim Preserve circ(m)
circ(m) = Rhino.AddInterpCurve (arrPtsCrv(m))
Rhino.ObjectColor circ(m),ParamColor(t)

ReDim Preserve arrCCX(m)
arrCCX(m) = Rhino.CurveCurveIntersection(circ(m),strCrv)
If isArray(arrCCX(m)) Then
Call Rhino.Print (“curves intersect”)
For i = 0 To UBound(arrCCX(m))
Dim strText
If arrCCX(m)(i,0) = 1 Then
Call Rhino.AddPoint (arrCCX(m)(i,1))
strtext = Rhino.AddText (“Point: ” & m+i & “Crv: ” & m & ” Intr: ” & i, arrCCX(m)(i,1),.5)
Rhino.ObjectColor strtext,ParamColor(t)
Else
Call Rhino.Print (“no intersections”)
End If
Next
End If
‘——————————————————————
Else
ReDim Preserve crvPt(m)
crvPt(m) = crvCurvature(0)

‘——————————————————————
‘IS THERE ANY WAY OF NOT REPEATING ALL THESE???
ReDim Preserve circ(m)
circ(m) = Rhino.AddCircle(arrPlane,Rhino.Distance(centBBPt,crvPt(m)))

Rhino.AddPoint crvPt(m)
ReDim Preserve arrCCX(m)
arrCCX (m) = Rhino.CurveCurveIntersection(circ(m),strCrv)

If isArray(arrCSX(m)) Then
Call Rhino.Print (“curves intersect: ” & “Circle: ” & m)
For i = 0 To UBound(arrCSX(m))
If arrCSX(i,0)(m) = 1 Then
Call Rhino.AddPoint (arrCSX(i,1)(m))
Else
Call Rhino.Print (“no intersections”)
End If
Next
End If
‘——————————————————————
End If

Next

End Sub

Function ParamColor(t)
Dim RedComponent : RedComponent = 255 * Abs(t)
If RedComponent <0 Then RedComponent=0
If RedComponent <255 Then RedComponent=255
ParamColor = RedComponent + 0*256 + (255-RedComponent)*65536
Rhino.Print ParamColor
End Function

Function ObtenerRGB(ByVal Color,ByVal Rojo,ByVal Verde,ByVal Azul)
Azul = (Color And 16711680) / 65536
Verde = (Color And 65280) / 256
Rojo = Color And 255
End Function


Categories: Adolfo Nadal

0 responses so far ↓

  • There are no comments yet...Kick things off by filling out the form below.

Leave a Comment