'-------------------------------------------------------------------------------------------------------- '-------------------------------------------------------------------------------------------------------- Sub initialize '--------------------------------------------------------------------- ' function calls: none ' draws: 2 circles '--------------------------------------------------------------------- arrPlane = Rhino.WorldXYPlane dblA = Rhino.GetReal ("Big circle radius:") dblB = Rhino.GetReal ("Small circle radius:") strCircleBig = Rhino.AddCircle (arrPlane, dblA) strCircleSmall = Rhino.AddCircle (arrPlane, dblB) MoveObject strCircleSmall, Array(0,0,0), Array(0,(dblA + dblB),0) End Sub '-------------------------------------------------------------------------------------------------------- '-------------------------------------------------------------------------------------------------------- Sub All '--------------------------------------------------------------------- ' function calls: CirclePatternLevel, MirrorBigCircle, All Circles ' draws: nothing(native) '--------------------------------------------------------------------- Dim intBmulti Dim arrObjectsZZ ,IntDist BigCircle = Rhino.GetObject ("select big circle") SmallCircle = Rhino.GetObject ("select small circle") intBmulti = Rhino.GetInteger ("multi/direction number (-10/+10) :") 'StopOnCollision = Rhino.GetInteger ("stop on collision mode 0:no 1:yes :") IntDist = Rhino.GetReal (" distance: (1)" , 1) dblNewZ = Rhino.GetReal ("define height: ") arrLevelResult = CirclePatternLevel (BigCircle,SmallCircle, intBmulti, StopOnCollision) BigCircleOld = arrLevelResult(0) SmallCircleArray = arrLevelResult(1) BigCircle = MirrorBigCircle (BigCircleOld, SmallCircleArray, intBmulti) arrObjectsZZ = Rhino.AllObjects '--------------------------------------------------------------call calculating routine Call PointDistance (arrObjectsZZ ,IntDist ,IntDel, dblNewZ ) End Sub '-------------------------------------------------------------------------------------------------------- '-------------------------------------------------------------------------------------------------------- Sub circlepattern '--------------------------------------------------------------------- ' function calls: CirclePatternLevel, MirrorBigCircle, All Circles ' draws: nothing(native) '--------------------------------------------------------------------- Dim intBmulti BigCircle = Rhino.GetObject ("select big circle") SmallCircle = Rhino.GetObject ("select small circle") intBmulti = Rhino.GetInteger ("multi/direction number (-10/+10) :") StopOnCollision = Rhino.GetInteger ("stop on collision mode 0:no 1:yes :") arrLevelResult = CirclePatternLevel (BigCircle,SmallCircle, intBmulti, StopOnCollision) BigCircleOld = arrLevelResult(0) SmallCircleArray = arrLevelResult(1) BigCircle = MirrorBigCircle (BigCircleOld, SmallCircleArray, intBmulti) End Sub '-------------------------------------------------------------------------------------------------------- '-------------------------------------------------------------------------------------------------------- Function CirclePatternLevel (BigCircle,SmallCircle, intBmulti, StopOnCollision) ' draws one strand of circle pattern, until collision. '--------------------------------------------------------------------- ' function calls: CreateSmallCircles, CreateBigCircle, isAutoCollision ' draws: nothing(native) ' returns: Array (BigCircleLast, SmallCircleArray) '--------------------------------------------------------------------- FirstBigCircle = BigCircle FirstBigCircleCenter = Rhino.CircleCenterPoint (FirstBigCircle) BigCircleRadius = Rhino.CircleRadius (FirstBigCircle) bigCircleCollision = -1 Do SmallCircleArray = CreateSmallCircles (BigCircle, SmallCircle, intBmulti,StopOnCollision) SmallCircle = SmallCircleArray (1) BigCircleOld = BigCircle BigCircle = CreateBigCircle (BigCircle, SmallCircle, intBmulti) BigCircleCenter = Rhino.CircleCenterPoint (BigCircle) bigCircleCollision = isAutoCollision (BigCircle) If (Not IsArray(bigCircleCollision)) Then Rhino.print "collisionbigcircle: " &CStr(bigCircleCollision) Else Rhino.print "collisionbigcirclearray: " &CStr(bigCircleCollision(0)) End If Loop While (Not IsArray(bigCircleCollision)And(Rhino.Distance (BigCircleCenter , FirstBigCircleCenter )>= (2 * BigCircleRadius * 0.99))) 'tolerance Rhino.DeleteObject BigCircle CirclePatternLevel = Array (BigCircleOld, SmallCircleArray) End Function '-------------------------------------------------------------------------------------------------------- Function isAutoCollision (BigCircle) ' checks if a circle intersects with other circles of the same radius '--------------------------------------------------------------------- ' function calls: allCircles, isAnyOverlap ' draws: nothing ' returns: on no collision --> -1 ' on collision --> Array of object handles '--------------------------------------------------------------------- Dim myCircles() theirCircles = allCircles myCircleCount = -1 If Not IsArray (theirCircles ) Then Exit Function End If For intI = 0 To UBound (theirCircles) If Rhino.CircleRadius (theirCircles(intI)) = Rhino.CircleRadius (BigCircle) Then myCircleCount = myCircleCount + 1 ReDim Preserve myCircles(myCircleCount) myCircles(myCircleCount) = theirCircles(intI) End If Next isAutoCollision = isAnyOverlap (BigCircle, myCircles) End Function '-------------------------------------------------------------------------------------------------------- '-------------------------------------------------------------------------------------------------------- Function isAnyOverlap (strCircle, arrCircles) ' checks if a circle intersects with circles of a given selection set '--------------------------------------------------------------------- ' function calls: none ' draws: nothing ' returns: on no collision --> -1 ' on collision --> Array of object handles '--------------------------------------------------------------------- Dim arrEvents () If IsArray(arrCircles) Then intI = UBound(arrCircles) Else intI = 0 End If If IsObject (arrCircles) Then intI = -1 End If If intI = 0 Then Exit Function End If isAnyOverlap = 0 maxElements = intI IntEventCount = -1 myCircleCenter = Rhino.CircleCenterPoint (strCircle) myCircleRadius = Rhino.CircleRadius (strCircle) ' loop all input objects For intI = 0 To maxElements theirCircleCenter = Rhino.CircleCenterPoint (arrCircles(intI)) theirCircleRadius = Rhino.CircleRadius (arrCircles(intI)) ourDistance = Rhino.Distance (myCircleCenter, theirCircleCenter) theirDistance = myCircleRadius + theirCircleRadius theirDistance = theirDistance * 0.99 '0.99 --> tolerance ' evaluate intersection: If (theirDistance > ourDistance) And (strCircle <> arrCircles(intI)) Then IntEventCount = IntEventCount + 1 ReDim Preserve arrEvents(IntEventCount) arrEvents(IntEventCount) = arrCircles(intI) End If Next ' format return variable: If IntEventCount = -1 Then isAnyOverlap = -1 Else isAnyOverlap = arrEvents End If End Function '-------------------------------------------------------------------------------------------------------- '-------------------------------------------------------------------------------------------------------- Function MirrorBigCircle (BigCircle, SmallCircleArray, intDirection) ' mirrors BigCircle around centerpoints of the first two elements of SmallCircleArray '--------------------------------------------------------------------- ' function calls: none ' draws: bigCircle ' returns: new Circle Handle '--------------------------------------------------------------------- MirrorAxisPoint1 = Rhino.CircleCenterPoint (SmallCircleArray(0)) MirrorAxisPoint2 = Rhino.CircleCenterPoint (SmallCircleArray(1)) Rhino.UnselectAllObjects Rhino.SelectObject BigCircle Rhino.Command "'_Mirror " & Rhino.Pt2Str (MirrorAxisPoint1) & " " & Rhino.Pt2Str (MirrorAxisPoint2) MirrorBigCircle = Rhino.LastObject () End Function '-------------------------------------------------------------------------------------------------------- '-------------------------------------------------------------------------------------------------------- Function CreateBigCircle (BigCircle, SmallCircle, intDirectionInput) ' draws a new BigCircle tangential to BigCircle and SmallCircle '--------------------------------------------------------------------- ' intDirection: positive or negative integer '--------------------------------------------------------------------- ' function calls: none ' draws: one big circle ' returns: new big circle object handle '--------------------------------------------------------------------- Dim strCircleB Dim strCircleS Dim dblB, dblS strCircleB = BigCircle strCircleS = SmallCircle intDirection = intDirectionInput / Abs(intDirectionInput) ' Rhino.print "BigCircle Dire: " & CStr (intDirection) dblB = Rhino.CircleRadius (strCircleB) dblS = Rhino.CircleRadius (strCircleS) '--------------------------------------------------------move a circle arrStart = Rhino.CircleCenterPoint (strCircleB) arrEnd = Rhino.CircleCenterPoint (strCircleS) strLine = Rhino.AddLine (arrStart, arrEnd) Rhino.ExtendCurveLength strLine, 0, 1, dblB - dblS arrStart = Rhino.CircleCenterPoint (strCircleB) arrEnd = Rhino.CurveEndPoint (strLine) Rhino.CopyObject strCircleB, arrStart, arrEnd strCircleBcopy = Rhino.LastObject () Rhino.DeleteObject (strLine) '------------------------------------------------------rotate a circle t = Sqr ((dblB + dblS)*(dblB + dblS) - dblB*dblB) / dblB dblAngle = Rhino.ToDegrees (Atn (t)) dblAngle = dblAngle * intDirection arrCenter = Rhino.CircleCenterPoint (strCircleB) Rhino.RotateObject strCircleBcopy, arrCenter, dblAngle CreateBigCircle = Rhino.LastObject () ' Rhino.print "bigCircle:" & CStr(CreateBigCircle) End Function '-------------------------------------------------------------------------------------------------------- '-------------------------------------------------------------------------------------------------------- Function CreateSmallCircles (BigCircle, SmallCircle, intBinput, StopOnCollision) ' draws circles tagential to input 2 circles, radius of SmallCircle '--------------------------------------------------------------------- ' intBinput: pos or neg integer, value: #child circles, ' -/+: direction of propagation ' StopOnCollision 1: stop on collision ' 0: don't stop. '--------------------------------------------------------------------- ' function calls: isAnyOverlap ' draws: circles ' returns: array of 2 last circle object handles ' (prevLastCircleDrawn, LastCircleDrawn) '--------------------------------------------------------------------- Dim dblB, dblS Dim b, i, j Dim ArrCircle dblB = Rhino.CircleRadius (BigCircle) dblS = Rhino.CircleRadius (SmallCircle) If intBinput < 0 Then intOrientation = -1 intB = 0 - intBinput Else intOrientation = 1 intB = intBinput End If ' Rhino.Print "smallCircle - intB: " & CStr(intB) & " direction: " & CStr(intOrientation) '-------------------------------------------------------rotate circles For j = 1 To intB PrevLastCircle = Rhino.LastObject () ArrCircle = Rhino.CopyObject (SmallCircle) b = dblS / Sqr ((dblB + dblS)*(dblB + dblS) - dblS*dblS) dblI = 2 * Rhino.ToDegrees (Atn (b)) i = j * dblI * intOrientation ' angle arrPoint = Rhino.CircleCenterPoint (BigCircle) ' rotation point Rhino.RotateObject ArrCircle, arrPoint, i ' Rhino.print "RotationAngle:" & CStr (i) '-----------------------on collision delete last circle, Exit Function strCircleError = ArrCircle arrCirclesError = allCircles xxEvent = isAnyOverlap (strCircleError, arrCirclesError) If IsArray (xxEvent) And StopOnCollision <> 0 Then Rhino.print "overlap.object center:" & Rhino.Pt2Str (Rhino.CircleCenterPoint(ArrCircle)) Rhino.DeleteObject (ArrCircle) Exit Function End If '------------------------------------------------------collision check CreateSmallCircles = Array (PrevLastCircle, Rhino.LastObject ()) ' Rhino.print "smallCircle:" & CStr(CreateSmallCircles) Next End Function '-------------------------------------------------------------------------------------------------------- '-------------------------------------------------------------------------------------------------------- Function allCircles 'returns an array of all circle object handles '--------------------------------------------------------------------- ' function calls: none ' draws: nothing ' returns: array of circle object handles '--------------------------------------------------------------------- Dim arrCircleGroup () ReDim arrCircleGroup (0) arrAllObjects = Rhino.AllObjects intObjCount = UBound(arrAllObjects) intCircleCount = -1 For intI = 0 To intObjCount If Rhino.IsCircle (arrAllObjects(intI)) Then intCircleCount = intCircleCount + 1 ReDim Preserve arrCircleGroup (intCircleCount) arrCircleGroup (intCircleCount) = arrAllObjects(intI) End If Next allCircles = arrCircleGroup End Function '-------------------------------------------------------------------------------------------------------- '-------------------------------------------------------------------------------------------------------- '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ttx2007 ' scope: ' take a set of center points and a distance: critical distance. ' move these points up to a certain height '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ROUTINES Sub PointCriticalDistanceVectors '----------------------------------------------------------------------------initialize Dim arrObjectsZZ ,intDist, IntDel, dblNewZ arrObjectsZZ = Rhino.GetObjects (" select circles..", 4) intDist = Rhino.GetReal (" distance: (1)" , 1) dblNewZ = Rhino.GetReal ("define height: ") '--------------------------------------------------------------call calculating routine Call PointDistance (arrObjectsZZ ,intDist ,IntDel, dblNewZ) End Sub '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++FUNCTIONS Function PointDistance (arrObjects, dblChkDistance, IntDeleteAllExistingLines, dblNewZ) ' input: ' array of circles (arrObjects) ' critical distance below which 2 points will be connected (dblChkDistance) ' option to delete all previously existing lines (IntDeleteAllExistingLines) ' new height of the points (dblNewZ) '----------------------------------------------------------------------------initialize Dim IntObjectCount, tempObject, arrDelObjects, arrAgates, arrGrgas, arrPoint, arrCenterPoint, arrPoints Dim IntI, IntJ, IntAktDistance, arrPoint1, arrPoint2 If IsArray(arrObjects) = False Then Exit Function IntCircleCount = UBound(arrObjects) For i = 0 To IntCircleCount arrCenterPoint = Rhino.CircleCenterPoint (arrObjects(i)) arrPoint = Rhino.AddPoint (arrCenterPoint) Next '---------------------------------------------------------------delete all circles arrDelObjects = Rhino.ObjectsByType(4) For IntI = 0 To UBound(arrDelObjects) tempObject = arrDelObjects(IntI) If Rhino.IsCircle (tempObject ) Then Rhino.DeleteObject (tempObject ) End If Next '---------------------------------------------------------------check the distance among points arrPoints = Rhino.ObjectsByType(1) IntObjectCount = UBound(arrPoints) For IntI = 0 To IntObjectCount For IntJ = 0 To IntObjectCount If Rhino.IsPoint(arrPoints(IntI )) Then If Rhino.IsPoint(arrPoints(IntJ )) Then arrPoint1=Rhino.PointCoordinates (arrPoints(IntI )) arrPoint2=Rhino.PointCoordinates (arrPoints(IntJ )) IntAktDistance = Rhino.Distance(arrPoint1,arrPoint2) If IntAktDistance <= dblChkDistance Then If IntAktDistance <> 0 Then tempObject = Rhino.AddLine (arrPoint1,arrPoint2) End If End If End If End If Next Next '---------------------------------------------------------------lifts up center points arrClemens = Rhino.ObjectsByType(4) IntLineCount = UBound(arrClemens) arrStart = Array(0,0,0) arrEnd = Array(0,0,dblNewZ) For i = 0 To IntLineCount arrAgates = Rhino.CurveStartPoint (arrClemens(i)) arrTitus = Rhino.AddPoint (arrAgates) Rhino.MoveObject arrTitus, arrStart, arrEnd arrGrgas = Rhino.CurveEndPoint (arrClemens(i)) arrTitus = Rhino.AddPoint (arrGrgas) Rhino.MoveObject arrTitus, arrStart, arrEnd Next '---------------------------------------------------------------delete all lines arrDelObjects = Rhino.ObjectsByType(4) For IntI = 0 To UBound(arrDelObjects) tempObject = arrDelObjects(IntI) If Rhino.IsLine (tempObject ) Then Rhino.DeleteObject (tempObject ) End If Next End Function '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Sub PointCriticalDistanceAndHeight ' input: ' critical distance below which 2 points will be connected (dblChkDistance) ' new height of the points (dblNewZ) '----------------------------------------------------------------------------initialize Dim IntObjectCount, tempObject, arrDelObjects, arrAgates, arrGrgas, arrPoint, arrCenterPoint, arrPoints, arrDupPoints Dim IntI, IntJ, IntAktDistance, arrPoint1, arrPoint2, b dblChkDistance1 = Rhino.GetReal (" 1st - the smallest distance: " , 1) dblChkDistance2 = Rhino.GetReal (" 2nd - middle distance: " , 3) dblChkDistance3 = Rhino.GetReal (" 3rd - the largest distance: " , 6) dblNewZ1 = Rhino.GetReal ("define height for the 1st distance: ") dblNewZ2 = Rhino.GetReal ("define height for the 2nd distance: ") dblNewZ3 = Rhino.GetReal ("define height for the 3rd distance: ") '---------------------------------------------------------------check the distance among points arrPoints = Rhino.ObjectsByType(1) If IsArray(arrPoints) = False Then Exit Sub IntObjectCount = UBound(arrPoints) For IntI = 0 To IntObjectCount For IntJ = 0 To IntObjectCount If Rhino.IsPoint(arrPoints(IntI )) Then If Rhino.IsPoint(arrPoints(IntJ )) Then arrPoint1 = Rhino.PointCoordinates (arrPoints(IntI )) arrPoint2 = Rhino.PointCoordinates (arrPoints(IntJ )) IntAktDistance = Rhino.Distance(arrPoint1,arrPoint2) '------------------------------------------------------------------------------------------------checks distance1 If IntAktDistance <> 0 Then If IntAktDistance <= dblChkDistance1 Then tempObject = Rhino.AddLine (arrPoint1,arrPoint2) '------------------------------------------------------------------------------------------------lifts up center points arrStart = Array(0,0,0) arrEnd = Array(0,0,dblNewZ1) arrAgates = Rhino.CurveStartPoint (tempObject) arrTitus = Rhino.AddPoint (arrAgates) Rhino.MoveObject arrTitus, arrStart, arrEnd arrGrgas = Rhino.CurveEndPoint (tempObject) arrTitus = Rhino.AddPoint (arrGrgas) Rhino.MoveObject arrTitus, arrStart, arrEnd '------------------------------------------------------------------------------------------------delete all lines arrDelObjects = Rhino.ObjectsByType(4) If Rhino.IsLine (tempObject ) Then Rhino.DeleteObject (tempObject ) End If End If '------------------------------------------------------------------------------------------------checks distance2 If ((IntAktDistance > dblChkDistance1) And (IntAktDistance <= dblChkDistance2)) Then tempObject = Rhino.AddLine (arrPoint1,arrPoint2) '------------------------------------------------------------------------------------------------lifts up center points arrStart = Array(0,0,0) arrEnd = Array(0,0,dblNewZ2) arrAgates = Rhino.CurveStartPoint (tempObject) arrTitus = Rhino.AddPoint (arrAgates) Rhino.MoveObject arrTitus, arrStart, arrEnd arrGrgas = Rhino.CurveEndPoint (tempObject) arrTitus = Rhino.AddPoint (arrGrgas) Rhino.MoveObject arrTitus, arrStart, arrEnd '------------------------------------------------------------------------------------------------delete all lines arrDelObjects = Rhino.ObjectsByType(4) If Rhino.IsLine (tempObject ) Then Rhino.DeleteObject (tempObject ) End If End If '------------------------------------------------------------------------------------------------checks distance3 If IntAktDistance <= dblChkDistance3 Then tempObject = Rhino.AddLine (arrPoint1,arrPoint2) '------------------------------------------------------------------------------------------------lifts up center points arrStart = Array(0,0,0) arrEnd = Array(0,0,dblNewZ3) arrAgates = Rhino.CurveStartPoint (tempObject) arrTitus = Rhino.AddPoint (arrAgates) Rhino.MoveObject arrTitus, arrStart, arrEnd arrGrgas = Rhino.CurveEndPoint (tempObject) arrTitus = Rhino.AddPoint (arrGrgas) Rhino.MoveObject arrTitus, arrStart, arrEnd '-----------------------------------------------------------------------------------------------delete all lines arrDelObjects = Rhino.ObjectsByType(4) If Rhino.IsLine (tempObject ) Then Rhino.DeleteObject (tempObject ) End If End If End If End If End If Next Next Rhino.Command ("SelDup") arrDupPoints = Rhino.SelectedObjects Rhino.DeleteObjects arrDupPoints Rhino.Command ("MeshPatch") End Sub Sub CirclePoints Dim IntCircleCount, arrPoint, arrCenterPoint, arrCircles, arrDelObjects, tempObject arrCircles = Rhino.ObjectsByType(4) If IsArray(arrCircles) = False Then Exit Sub IntCircleCount = UBound(arrCircles) For i = 0 To IntCircleCount arrCenterPoint = Rhino.CircleCenterPoint (arrCircles(i)) arrPoint = Rhino.AddPoint (arrCenterPoint) Next arrDelObjects = Rhino.ObjectsByType(4) For IntI = 0 To UBound(arrDelObjects) tempObject = arrDelObjects(IntI) If Rhino.IsCircle (tempObject ) Then Rhino.DeleteObject (tempObject ) End If Next End Sub