'[DIRECTORY] '================================================================================================== ' MAIN ' Sub MoveCurveOnce ' Sub MoveCurveAllTheWay ' Sub MoveMoreCurvesAllTheWay_STACK ' AUX ' Function moveCurve ( strObject ) ' Sub test_DoCurvesIntersect ' Function DoCurvesIntersect (strCurve1, strCurve2) ' Sub test_DoesCurveIntersectWithAnyOther ' Function DoesCurveIntersectWithAnyOther (strCurve1, arrCurves) '================================================================================================== '[DIRECTORY][%end] '[CODEPAGE] '================================================================================================== '================================================================================================== Sub MoveCurveOnce ' specify the object to move: strCurve = Rhino.GetObject("please select a curve",4) '4 means only curves. Rhino.print "der inhalt von strCurve ist " & strCurve ' call the function : ' format : ' returnValue = functionName (parameters) arrData = moveCurve(strCurve) ' arrData collects the return value of the function. End Sub '================================================================================================== '================================================================================================== Sub MoveCurveAllTheWay ' specify the object to move: strCurve = Rhino.GetObject("please select a curve",4) '4 means only curves. blnMOVED = vbTrue intCount = 0 ' call the function multiple times: While blnMOVED 'BEGIN LOOP blnMOVED = moveCurve(strCurve) ' blnMOVED collects the return value of the function. intCount = intCount + 1 ' add one Rhino.print CStr(intCount) Wend 'END LOOP End Sub '================================================================================================== '================================================================================================== Sub MoveMoreCurvesAllTheWay_STACK ' google this for help on UBound : VISUAL BASIC REFERENCE UBOUND arrCurves = Rhino.getobjects ("select curves",4) ' array of curve object handles ' TABLE of DEAD or ALIVE values for each curve : ' ------------------------------------------------ ' arrCurves arrTable ' ------------------------------- ' curve1 vbTrue (ALIVE) ' curve2 vbTrue ' curve3 vbTrue '1. set the size of the arrTable variable to the size of arrCurves. arrTable = arrCurves '2. fill ALIVE values for each curve: intTableSize = UBound(arrTable) For i = 0 To intTableSize arrTable(i) = Not DoesCurveIntersectWithAnyOther (arrCurves(i), arrCurves) Next ' ------------------------------------------------ 'Rhino.AddText strText,arrPoint,1 'if we dont care about the return value of the function, then no need for brackets intCurveCount = UBound(arrCurves) For i = 0 To intCurveCount strCurve = arrCurves(i) arrPoint = Rhino.curveendpoint(strCurve) strText = "arrCurves("&CStr(i) &")" strObjectT = Rhino.addtext(strText,arrPoint,1) ' now i care about the reutrn value Next ' number = ubound( anyKindOfArray ) // an array is a collection of values intCurveCount = UBound(arrCurves) ' here i figure out the number of data in the array blnANYCURVEMOVES = vbTrue ' -------------------------------------------- arrMessage = Array("-","+","*","+") iM = 0 ' -------------------------------------------- While blnANYCURVEMOVES ' :: blnCHANGED ' set abort condition default : blnANYCURVEMOVES = vbFalse ' if i have many objects, and my function wants exactly one object then i have to do it like this: ' move each curve one by one. For i = 0 To intCurveCount ' initialize boolean marker blnMOVED: blnMOVED = vbFalse strObject = arrCurves(i) 'extract one value fvrom an array ' if object is alive : If arrTable(i) Then ' move object, set boolean marker blnMOVED: blnMOVED = moveCurve( strObject ) 'aufruf der funktion End If ' check for intersection: If blnMOVED Then blnINTERSECT = DoesCurveIntersectWithAnyOther (strObject, arrCurves) ' if there is anintersection, then :: disable the curve: If blnINTERSECT Then arrTable(i) = vbFalse End If ' here we set an abort condition for the while loop: Rhino.print "CurveMoved ::"& CBool(blnMOVED) ' if all blnMOVED values are false, then (STOP) set blnANYCURVEMOVES false. ' if any blnMOVED value is true, then set blnANYCURVEMOVES true. If blnMOVED Then blnANYCURVEMOVES = vbTrue Next ' make a sign that u are alive: ' -------------------------------------------- Rhino.print arrMessage(iM) iM = iM + 1 If iM > UBound(arrMessage) Then iM = 0 End If ' -------------------------------------------- Wend End Sub '================================================================================================== ' functions cant be called by the user. ' functions can only be called by other functions or by sub routines '================================================================================================== Function moveCurve ( strObject ) ' specify a default return value : moveCurve = vbFalse ' read curve points : arrPoints = Rhino.curvepoints(strObject) ' find the curve point with the lowest z value: dZminimum = arrPoints(0)(2) ' take the z value of the first point ' initializing the loop: ' ------------------------------------------------------- iPointCount = UBound(arrPoints) ' length of an array intPoint = 0 ' ------------------------------------------------------- For i = 0 To iPointCount aPoint1 = arrPoints(i) ' extracting one element from an array dZValue = aPoint1(2) 'Rhino.addtext CStr(dZValue), aPoint1 If dZValue < dZminimum Then dZminimum = dZValue ' set new minimum z value intPoint = i ' remember which was the lowest point End If Next ' ------------------------------------------------------- ' mark the lowest point: Rhino.addtext CStr(dZminimum), arrPoints(intPoint) ' if the lowest point is above 0 then move one down: ' ------------------------------------------------------- If dZminimum > 0 Then PointStart = Array(0,0,1) PointEnd = Array(0,0,0) Rhino.moveobject strObject, PointStart, PointEnd moveCurve = vbTrue ' set return value . End If End Function '================================================================================================== ' this is the data in arrpoints: array( (x0,y0,z0),(x1,y1,z1),(x2,y2,z2),(x3,y3,z3)) ' arrPoints(0)(2)..............: z0 '================================================================================================== Sub test_DoCurvesIntersect ' input from the user: strCurve1 = Rhino.GetObject("curve1",4) strCurve2 = Rhino.GetObject("curve2",4) ' call (use) the function : blnINTERSECT = DoCurvesIntersect (strCurve1, strCurve2) ' display the result(output) of the function: If blnINTERSECT Then Rhino.print "they intersect. //"&CBool(blnINTERSECT) ' to print a boolean use CBool() Else Rhino.print "they dont intersect. //"&CBool(blnINTERSECT) End If End Sub '================================================================================================== '================================================================================================== Function DoCurvesIntersect (strCurve1, strCurve2) 'set the default return value : DoCurvesIntersect = vbFalse 'are the 2 input curves identical? if, so : exit. 'strCurve1 = strCurve2 'here we check if 2 strings are identical: If StrComp (strCurve1, strCurve2) = 0 Then Exit Function ' so only continue if the curves are not the same. ' get intersection data : arrData = Rhino.curvecurveintersection(strCurve1,strCurve2) ' does the intersection data contain values or not: ' if intersection data is an array (intersection exists between curves), then set return value to true. If IsArray(arrData) Then DoCurvesIntersect = vbTrue End Function '================================================================================================== '================================================================================================== Sub test_DoesCurveIntersectWithAnyOther strCurve1 = Rhino.GetObject("curve1",4) arrCurves = Rhino.GetObjects("curves",4) blnINTERSECT = DoesCurveIntersectWithAnyOther (strCurve1, arrCurves) '[FUNCCALL] If blnINTERSECT Then Rhino.print "it intersects. //"&CBool(blnINTERSECT) ' to print a boolean use CBool() Else Rhino.print "it does not intersect. //"&CBool(blnINTERSECT) End If End Sub '================================================================================================== '================================================================================================== Function DoesCurveIntersectWithAnyOther (strCurve1, arrCurves) 'strCurve1 is a single curve object. 'arrCurves is a collection (array) of curve objects. 'purpose of the funciton is to tell if the curve intersects with ANYONE curve. '1. set default return value: DoesCurveIntersectWithAnyOther = vbFalse ' 2. loop, check each object in arrCurves with Curve1: ' this is the logic of :: For Each In ' For i = 0 To UBound(arrCurves) ' strCurve2 = arrCurves(i) ' Next For Each strCurve2 In arrCurves blnINTERSECT = DoCurvesIntersect (strCurve1, strCurve2) If blnINTERSECT Then DoesCurveIntersectWithAnyOther = vbTrue Next End Function '================================================================================================== '================================================================================================== '[CODEPAGE][%end]