Option Explicit
‘Script written by Macus Chen
‘Script copyrighted by <insert company name>
‘Script version Friday, November 13, 2009 10:55:04 PM
Call Main()
Sub Main()
Dim strCurveID, t, arrPt, arrPts(),arrObstacles, threshold
strCurveID = Rhino.GetObject(“Select a curve to sample”, 4, True, True)
arrObstacles = rhino.GetObjects(“select obstacle points”,1)
threshold = rhino.GetReal(“enter a threshold”,3.2)
Dim count,transPt, transPtOld, transPtNew, interLine, arrParameter
Dim midPt, newCrv
Dim arrPt1(), arrPt2()
rhino.AddLayer “substanceProfile”, RGB(255,0,0)
count = 0
For t = 0.0 To 1.0 Step 0.025
ReDim Preserve arrPts(count)
If count > 0 Then
transPtOld = transPt ‘TRANS2
End If
arrParameter = AddPointAtR1Parameter(strCurveID, t,arrObstacles,threshold)
ReDim Preserve arrPt1(count)
ReDim Preserve arrPt2(count)
arrPt1(count) = arrParameter(1)
arrPt2(count) = arrParameter(2)
arrPts(count) = arrParameter(0)
transPt = arrParameter(2)’TRANS1
transPtNew = arrParameter(1)
‘rhino.Addpoint transPt
If count > 0 Then
interLine = rhino.AddLine(transPtOld, transPtNew)
midPt = rMidPrepPt(interLine)
newCrv = rhino.AddCurve(array(transPtOld,midPt,transPtNew))
rhino.DeleteObject interLine
End If
count = count + 1
Next
‘Dim profileCrv1, profileCrv2, profile
‘profileCrv1 = rhino.AddCurve(arrPt1)
‘ProfileCrv2 = rhino.AddCurve(arrPt2)
Dim profile
profile = connectCrv(arrPt1,arrPt2)
Rhino.ObjectLayer profile, “substanceProfile”
‘Rhino.ObjectLayer profileCrv1, “substanceProfile”
‘Rhino.ObjectLayer profileCrv2, “substanceProfile”
‘Call Rhino.EnableRedraw(True)
End Sub
Function connectCrv(crv1,crv2)
‘print Ubound(crv2)
Dim count,count2, i, j, arrProfilePts()
count = 0
For i = 0 To Ubound(crv1)
ReDim Preserve arrProfilePts(count)
arrProfilePts(count) = crv1(i)
count = count + 1
Next
count = Ubound(arrProfilePts)+1
count2 = count
For j = Ubound(crv2) + count To count Step -1
‘print count
‘print j
ReDim Preserve arrProfilePts(count)
arrProfilePts(count) = crv2(j-count2)
count = count + 1
Next
count = Ubound(arrProfilePts)+1
ReDim Preserve arrProfilePts(count)
arrProfilePts(count) = arrProfilePts(0)
connectCrv = rhino.AddCurve(arrProfilePts)
End Function
Function AddPointAtR1Parameter(strCurveID, dblUnitParameter,arrObstacles,threshold)
AddPointAtR1Parameter = Null
Dim crvDomain, dblR1Param, arrR3Point, strPointID
crvDomain = Rhino.CurveDomain(strCurveID)
dblR1Param = crvDomain(0) + dblUnitParameter * (crvDomain(1) – crvDomain(0))
arrR3Point = Rhino.EvaluateCurve(strCurveID, dblR1Param)
strPointID = Rhino.AddPoint(arrR3Point)
‘AddPointAtR1Parameter = strPointID
Dim tangentVec, prepVec,reversePrepVec
tangentVec = Rhino.CurveCurvature(strCurveID, dblUnitParameter)(1)
prepVec = rhino.VectorRotate(tangentVec,-90,array(0,0,1))
prepVec = rhino.VectorUnitize(prepVec)
prepVec = rhino.VectorScale(prepVec,1.75+rnd*1)
reversePrepVec = rhino.VectorReverse(prepVec)
Dim pt1, pt2, midPt
pt1 = rhino.PointAdd(arrR3Point, prepVec)
pt2 = rhino.PointAdd(arrR3Point, reversePrepVec)
midPt = array((pt1(0)+pt2(0))/2,(pt1(1)+pt2(1))/2,(pt1(2)+pt2(2))/2)
pt1 = scale (arrObstacles,threshold,pt1,midPt)
pt2 = scale (arrObstacles,threshold,pt2,midPt)
‘pt1 = rhino.AddPoint(pt1)
‘pt2 = rhino.AddPoint(pt2)
Dim crv ,newCrv
crv = rhino.AddLine(pt1,pt2)
midPt = midPrepPt(crv)
newCrv = rhino.AddCurve(array(pt1,midPt,pt2))
rhino.DeleteObject crv
AddPointAtR1Parameter = array(strPointID,pt1,pt2)
End Function
Function midPrepPt(line)
Dim startPt, endPt, midPt
startPt = Rhino.CurveStartPoint(line)
endPt = Rhino.CurveEndPoint(line)
midPt = Rhino.CurveMidPoint(line)
Dim vec
vec = rhino.VectorCreate(endPt,startPt)
vec = rhino.VectorRotate(vec,90,array(0,0,1)) ”rotate nishizhen
vec = rhino.VectorUnitize(vec)
vec = rhino.VectorScale(vec,0.75)
Dim addMidPt
addMidPt = rhino.PointAdd(midPt,vec)
midPrepPt = addMidPt
‘rhino.AddPoint addMidPt
End Function
Function rMidPrepPt(line)
Dim startPt, endPt, midPt
startPt = Rhino.CurveStartPoint(line)
endPt = Rhino.CurveEndPoint(line)
midPt = Rhino.CurveMidPoint(line)
Dim vec
vec = rhino.VectorCreate(endPt,startPt)
vec = rhino.VectorRotate(vec,-90,array(0,0,1)) ”rotate nishizhen
vec = rhino.VectorUnitize(vec)
vec = rhino.VectorScale(vec,0.75)
Dim addMidPt
addMidPt = rhino.PointAdd(midPt,vec)
rMidPrepPt = addMidPt
‘rhino.AddPoint addMidPt
End Function
Function scale (arrObstacles,threshold,pt,midPt)
dim j,xyzPt,attXYZArr(),closestPtIndex,dist,adjAmount,vec,newPt
‘find the closetobstacles
For j = 0 To UBound(arrObstacles)
xyzPt = Rhino.PointCoordinates(arrObstacles(j))
ReDim Preserve attXYZArr(j)
attXYZArr(j) = xyzPt
Next
‘calculate pt1, pt2 dist to obstacles
closestPtIndex = Rhino.PointArrayClosestPoint(attXYZArr, pt)
dist = Rhino.Distance(pt, attXYZArr(closestPtIndex))
‘if dist in threshold
If dist < threshold Then
adjAmount = 1 – ((threshold – dist)/threshold)
Else
adjAmount = 1
End If
‘move pt toward the mid pt
vec = rhino.VectorCreate(pt,midPt)
vec = rhino.VectorScale(vec,adjAmount)
newPt = rhino.PointAdd(midPt,vec)
‘return the new pos of pt
scale = newPt
End Function
Function at_ChangeColor(obj,tDist,aDist,sFactor)
Dim objColor, newColor
‘ caculate color
newColor = 255 – ((1 – ((tDist – aDist)/tDist)) * 255)
‘newColor = 255
‘ change color
objColor = Rhino.ObjectColor(obj, newColor)
‘Rhino.print objColor
‘ at_ChangeColor=
End Function
Function hole (arrPt)
arrPt = rhino.PointCoordinates(arrPt)
Dim vec1, vec2, vec3, vec4
Dim pt1, pt2, pt3, pt4
Dim crv
vec1 = array(0.5+0.5*rnd,0,0)
vec2 = array(0.25+0.25*rnd,0,0)
vec3 = array(0.5+0.5*rnd,0,0)
vec4 = array(0.25+0.25*rnd,0,0)
vec1 = rhino.VectorRotate(vec1,30*rnd-15,array(0,0,1))
vec2 = rhino.VectorRotate(vec2,30*rnd-15+90,array(0,0,1))
vec3 = rhino.VectorRotate(vec3,30*rnd-15+180,array(0,0,1))
vec4 = rhino.VectorRotate(vec4,30*rnd-15+270,array(0,0,1))
pt1 = rhino.PointAdd(arrPt,vec1)
pt2 = rhino.PointAdd(arrPt,vec2)
pt3 = rhino.PointAdd(arrPt,vec3)
pt4 = rhino.PointAdd(arrPt,vec4)
crv = rhino.AddCurve(array(pt1,pt2,pt3,pt4,pt1))
hole = crv
End Function
