(*^ ::[ frontEndVersion = "Microsoft Windows Mathematica Notebook Front End Version 2.2"; microsoftWindowsStandardFontEncoding; fontset = title, "Times New Roman", 24, L0, center, nohscroll, bold; fontset = subtitle, "Times New Roman", 18, L0, center, nohscroll, bold; fontset = subsubtitle, "Times New Roman", 14, L0, center, nohscroll, italic; fontset = section, "Times New Roman", 18, L0, nohscroll, bold, grayBox; fontset = subsection, "Times New Roman", 14, L0, nohscroll, bold, blackBox; fontset = subsubsection, "Times New Roman", 13, L0, nohscroll, B65535; fontset = text, "Times New Roman", 12, L0, nohscroll, cellOutline; fontset = smalltext, "Times New Roman", 10, L0, nohscroll; fontset = input, "Courier New", 12, L-5, nowordwrap, bold; fontset = output, "Courier New", 12, L-5, nowordwrap; fontset = message, "Courier New", 12, L-5, nowordwrap, R65535; fontset = print, "Courier New", 12, L-5, nowordwrap; fontset = info, "Courier New", 12, L-5, nowordwrap, B65535; fontset = postscript, "Courier New", 12, L0, nowordwrap; fontset = name, "Arial", 10, L0, nohscroll, italic; fontset = header, "Times New Roman", 12, L0; fontset = footer, "Times New Roman", 12, L0, center; fontset = help, "Times New Roman", 10, L0, nohscroll; fontset = clipboard, "Times New Roman", 12, L0, nohscroll; fontset = completions, "Times New Roman", 12, L0, nohscroll; fontset = graphics, "Courier New", 10, L0, nowordwrap, nohscroll; fontset = special1, "Times New Roman", 12, L0, nohscroll; fontset = special2, "Times New Roman", 12, L0, nohscroll; fontset = special3, "Times New Roman", 12, L0, nohscroll; fontset = special4, "Times New Roman", 12, L0, nohscroll; fontset = special5, "Times New Roman", 12, L0, nohscroll; fontset = leftheader, "Times New Roman", 12, L2; fontset = leftfooter, "Times New Roman", 12, L2; fontset = reserved1, "Courier New", 10, L0, nowordwrap, nohscroll;] :[font = title; inactive; preserveAspect; nohscroll; center; ] MathLive Professional :[font = subsubtitle; inactive; preserveAspect; startGroup; nohscroll; center; ] WormGear example Original by L.Angrave 1996 Last Update: 21/4/96 :[font = section; inactive; preserveAspect; startGroup; nohscroll; ] Introductory Notes :[font = subsubsection; inactive; preserveAspect; endGroup; nohscroll; ] This notebook creates a simple worm and mesh gear. We then rotate both parts in a short list animation. The initialisation cells create the object in MathLive and will animate it. :[font = section; inactive; initialization; preserveAspect; startGroup; Cclosed; nohscroll; ] Define Graphics :[font = subsection; inactive; initialization; preserveAspect; startGroup; Cclosed; nohscroll; ] Load the required packages and define our global variables :[font = input; initialization; preserveAspect; nowordwrap; ] *) General::spell1 //Off; Needs["Graphics`ParametricPlot3D`"]; Needs["MathLive`MathLive`"]; (* :[font = subsubsection; inactive; initialization; preserveAspect; startGroup; nohscroll; ] Worm gear parameters :[font = input; initialization; preserveAspect; endGroup; nowordwrap; ] *) helixRadius = 4; helixLength = 8; helixTurns = 5; helixSteps = 100; wormShaftDiagonal = 1; wormShaftStart = -5; (* :[font = subsubsection; inactive; initialization; preserveAspect; startGroup; nohscroll; ] Cog parameters :[font = input; initialization; preserveAspect; endGroup; endGroup; nowordwrap; ] *) nTeeth = 20; toothSeparation = helixLength / helixTurns; circumference = nTeeth toothSeparation; radius = circumference / ( 2 Pi ); Xposition = radius + helixRadius; toothDepth = helixRadius /4; turningRatio = 1 / nTeeth; (* :[font = subsection; inactive; initialization; preserveAspect; startGroup; Cclosed; nohscroll; ] Create worm gear graphics :[font = subsubsection; inactive; initialization; preserveAspect; startGroup; nohscroll; ] The worm gear is a finely spaced helix protuding from a central cylinder :[font = input; initialization; preserveAspect; nowordwrap; ] *) helixCurve = Table[ N[ {helixRadius Sin[2 Pi helixTurns t ] , helixRadius Cos[2 Pi helixTurns t] , helixLength t} ] , {t,-0.5,.5,1/ helixSteps} ]; (* :[font = input; initialization; preserveAspect; endGroup; nowordwrap; ] *) helixPolygons= Table[ { Hue[i / helixSteps ] , Polygon[ { helixCurve[[i]] , helixCurve[[i + 1 ]] , {0.1,0.1,1} helixCurve[[i + 1 ]] , {0.1,0.1,1} helixCurve[[i]] } ] } , {i, Length[helixCurve ]-1} ]; (* :[font = subsubsection; inactive; initialization; preserveAspect; startGroup; nohscroll; ] Create teeth of the simple cog :[font = input; initialization; preserveAspect; nowordwrap; ] *) wormGraphics = Graphics3D[{ Hue[0] , Cuboid[ { - wormShaftDiagonal, -wormShaftDiagonal ,wormShaftStart} , { wormShaftDiagonal , wormShaftDiagonal , helixLength + 0.5} ] , helixPolygons }]; (* :[font = input; initialization; preserveAspect; endGroup; nowordwrap; ] *) radianStep = 2 Pi / ( nTeeth 5 ); cogGraphics = Graphics3D[{Thickness[0.04],Hue[0], Line[ Table[ d = radius + toothDepth Sin[ theta nTeeth ]; {Xposition+ d Cos[theta] , 0,d Sin[theta]} , {theta, 0 , 2 Pi , radianStep} ] ]} ]; (* :[font = subsubsection; inactive; initialization; preserveAspect; startGroup; nohscroll; ] Create graphics in Mathematica :[font = input; initialization; preserveAspect; endGroup; endGroup; endGroup; nowordwrap; ] *) (* Show[{ wormGraphics, cogGraphics}, Lighting->False , ViewPoint-> {0,-4,0} ]; *) (* :[font = section; inactive; initialization; preserveAspect; startGroup; Cclosed; nohscroll; ] Create Objects in MathLive :[font = subsubsection; inactive; initialization; preserveAspect; startGroup; nohscroll; ] Start MathLive :[font = input; initialization; preserveAspect; endGroup; nowordwrap; ] *) LaunchLive[]; ResetLive[]; Live[ Change[ Camera["Camera"] , Visible->Off]]; (* :[font = subsubsection; inactive; initialization; preserveAspect; startGroup; nohscroll; ] Define the Model Range :[font = input; initialization; preserveAspect; endGroup; nowordwrap; ] *) Live[ Change[ Model3D["Default`"] , ModelRange-> {{-7,-7,-7},{16,16,16}} ]]; (* :[font = subsubsection; inactive; initialization; preserveAspect; startGroup; nohscroll; ] Create objects in MathLive :[font = input; initialization; preserveAspect; endGroup; nowordwrap; ] *) Live[ Create[ Object3D["Worm"], wormGraphics ] ]; Live[ Create[ Object3D["Cog" ], cogGraphics ] ]; (* :[font = subsubsection; inactive; initialization; preserveAspect; startGroup; nohscroll; ] Set Rotation Points :[font = input; initialization; preserveAspect; endGroup; nowordwrap; ] *) Live[ Change[ Object3D["Cog" ] , PointOfRotation -> {Xposition,0,0} ] ]; Live[ Change[ Object3D["Worm" ], PointOfRotation -> {0,0,0} ] ]; (* :[font = subsubsection; inactive; initialization; preserveAspect; startGroup; nohscroll; ] Stop the user from moving the individual parts- :[font = input; initialization; preserveAspect; endGroup; endGroup; nowordwrap; ] *) Live[ Change[ {Object3D["Cog" ] , Object3D["Worm"]} , MouseMovement -> False ]]; (* :[font = section; inactive; preserveAspect; startGroup; Cclosed; nohscroll; ] Animate :[font = subsubsection; inactive; preserveAspect; startGroup; nohscroll; ] Create a list animation and send it to MathLive :[font = input; initialization; preserveAspect; endGroup; nowordwrap; ] *) anim = Table[{ Change[ Object3D["Worm" ] , AxisAndAngle-> { {0,0,1}, psi} ] , Change[ Object3D["Cog" ] , AxisAndAngle-> { {0,1,0}, turningRatio psi} ] } , { psi,0, 8 Pi ,Pi/8} ]; Live[ anim ]; (* :[font = subsubsection; inactive; preserveAspect; endGroup; nohscroll; ] You can repeat this animation from within MathLive :[font = section; inactive; preserveAspect; startGroup; nohscroll; ] For further information, advice or suggestions please contact- :[font = text; inactive; preserveAspect; endGroup; endGroup; nohscroll; cellOutline; backColorRed = 65535; backColorGreen = 65535; backColorBlue = 65535; fontColorRed = 0; fontColorGreen = 0; fontColorBlue = 0; plain; fontName = "Times"; fontSize = 12; ] Email: support@milohedge.com Post: Milo Hedge Ltd, The Oxford Centre for Innovation, Mill Street, Oxford, OX2 0JX WWW: http://www.milohedge.com/mathlive/ ^*)