Bevel Gears

The Gear Teeth

Preliminaries

ff[r_] :=  {-r Cos[r] + Sin[r], 
        Min[{{Cos[r] + r Sin[r]},  .9}]}

gearpts = 
      Select[Table[
          ff[t] - {2.08, 0}, {t, 2. , π,  .005}], #[[1]] > 
            0 &];

gearpts =  
      Join[Reverse@(Map[{-1, 1} # &, gearpts]), 
        gearpts];

{constrt, 
        ext} = {Last[gearpts][[1]], Last[
            Select[gearpts, 
              Abs[#[[2]]] < 
                  (10^(-2)) &]][[1]]}

conpts = 
      Table[{t, -1.0}, {t, constrt +  .001, 2  ext,  .005}];

gearpts =  
      Join[Reverse@(Map[{-1, 1} # &, conpts]), gearpts, 
        conpts];

toothfn  =  
      Interpolation[gearpts, InterpolationOrder  ->  1];

lims = toothfn[[1, 1]];

The basic tooth function

grtuth[t_] =  { t, 
        toothfn[lims[[2]] Mod[t, 2, -1]]/2. };

The 3D stuff

Preliminaries

Working in (ℝ^3) we have to decide how to orient the gears. Three obvious choices are to have the axes of rotation parallel to the coordinate axes and that is the approach used here. The easy way to do this is to define a function for each orientation and then call the function required by the user.

These are the functions to create gears parallel to the coordinate plans.

makeXBevelgear[angvar_Symbol, radvar_Symbol, rad_?NumericQ, 
        teeth_Integer, θ_?NumericQ, toothht_?NumericQ, 
        thcknss_?NumericQ, grstyle_] := 
      Module[{rrinner, rrouter, radfn1inner, radfn1outer, radfn2, rr, 
          dthk}, 
rrinner  = 
          rad -  thcknss Tan[θ]/2; 
rrouter   = 
          rad +  thcknss Tan[θ]/2; 
rrbevel  =  
          rrouter  -  
            radvar Tan[θ] thcknss; 
radfn1inner[
            rr_] :=  rr  (rrinner +  
                toothht grtuth[ 
                      2 teeth angvar][[2]]); 
radfn1outer[rr_] :=  
          rr  (rrouter +  
                toothht grtuth[ 
                      2 teeth angvar][[2]]); 
radfn2 := (rrbevel +  
              toothht grtuth[ 
                    2 teeth angvar][[2]]); 
dthk =  
          thcknss/2; 
{{ dthk, 
            radfn1inner[radvar] Cos[2 π angvar], 
            radfn1inner[radvar] Sin[2 π angvar], 
            grstyle}, {- dthk, 
            radfn1outer[radvar] Cos[2 π angvar], 
            radfn1outer[radvar] Sin[2 π angvar], 
            grstyle}, 
{- dthk + thcknss radvar, 
            radfn2 Cos[2 π angvar], radfn2 Sin[2 π angvar], 
            grstyle}}
]

makeYBevelgear[angvar_Symbol, radvar_Symbol, rad_?NumericQ, 
        teeth_Integer, θ_?NumericQ, toothht_?NumericQ, 
        thcknss_?NumericQ, grstyle_] := 
      Module[{rrinner, rrouter, radfn1inner, radfn1outer, radfn2, rr, 
          dthk}, 
rrinner  = 
          rad -  thcknss Tan[θ]/2; 
rrouter   = 
          rad +  thcknss Tan[θ]/2; 
rrbevel  =  
          rrouter  -  
            radvar Tan[θ] thcknss; 
radfn1inner[
            rr_] :=  rr  (rrinner +  
                toothht grtuth[ 
                      2 teeth angvar][[2]]); 
radfn1outer[rr_] :=  
          rr  (rrouter +  
                toothht grtuth[ 
                      2 teeth angvar][[2]]); 
radfn2 := (rrbevel +  
              toothht grtuth[ 
                    2 teeth angvar][[2]]); 
dthk =  
          thcknss/2; 
{{ 
            radfn1inner[radvar] Cos[2 π angvar], dthk, 
            radfn1inner[radvar] Sin[2 π angvar], 
            grstyle}, {radfn1outer[radvar] Cos[2 π angvar], - 
              dthk, radfn1outer[radvar] Sin[2 π angvar], 
            grstyle}, 
{radfn2 Cos[2 π angvar], - 
                dthk + thcknss radvar, radfn2 Sin[2 π angvar], 
            grstyle}}
]

makeZBevelgear[angvar_Symbol, radvar_Symbol, rad_?NumericQ, 
        teeth_Integer, θ_?NumericQ, toothht_?NumericQ, 
        thcknss_?NumericQ, grstyle_] := 
      Module[{rrinner, rrouter, radfn1inner, radfn1outer, radfn2, rr, 
          dthk}, 
rrinner  = 
          rad -  thcknss Tan[θ]/2; 
rrouter   = 
          rad +  thcknss Tan[θ]/2; 
rrbevel  =  
          rrouter  -  
            radvar Tan[θ] thcknss; 
radfn1inner[
            rr_] :=  rr  (rrinner +  
                toothht grtuth[ 
                      2 teeth angvar][[2]]); 
radfn1outer[rr_] :=  
          rr  (rrouter +  
                toothht grtuth[ 
                      2 teeth angvar][[2]]); 
radfn2 := (rrbevel +  
              toothht grtuth[ 
                    2 teeth angvar][[2]]); 
dthk =  
          thcknss/2; 
{{ 
            radfn1inner[radvar] Cos[2 π angvar], 
            radfn1inner[radvar] Sin[2 π angvar], dthk, 
            grstyle}, {radfn1outer[radvar] Cos[2 π angvar], 
            radfn1outer[radvar] Sin[2 π angvar], - dthk, 
            grstyle}, 
{radfn2 Cos[2 π angvar], 
            radfn2 Sin[2 π angvar], - dthk + thcknss radvar, 
            grstyle}}
]

The 3D Function

There are two options for the MakeGear3D function. Since we will use it with ParametricPlot3D we have to include any styles for the gears as a fourth argument in the tuple. Hence we have an option GearStyle. The orientation is also set using the option GearAxel which will accept the values XAxis, YAxis and ZAxis. Note that in addition to the arguments for the 2D case we need to specify the thickness of the gear.

Options[MakeBevelGear3D] =  {GearStyle ->  EdgeForm[], 
        GearAxel ->  XAxis}

MakeBevelGear3D::usage = "MakeGear[arg, abs, radius, teeth,ang, \
tooth-height, thickness, center, opts] creates a function that can be used to \
plot a gear using ParametricPlot3D. The first two arguments arg and rad \
specify the argument and radius vector of a function in polar coordinates. \
The third argument gives the radius of the gear, the fourth the number of \
teeth, the fifth argument give the angle of the teeth measured from the \
perpendicular to the face of the gear, the sixth the height of the teeth and \
the seventh the center of the gear in three-space. It accepts the options \
GearStyle and GearAxel. The first lets the user set the color of the gear \
surface and whether or not to include a mesh. The second is used to determine \
the orientation of the gear.";

MakeBevelGear3D[arg_Symbol, mag_Symbol, rad_?NumericQ, teeth_Integer, 
        ang_ /; -π/2 < ang < π/2, toothHt_?NumericQ, 
        thckness_?NumericQ, center_?VectorQ, opts___?OptionQ] :=  
      Module[{orient, 
          grstyle}, 
orient =  GearAxel /. {opts} /. 
            Options[MakeBevelGear3D]; 
grstyle  =  GearStyle /. {opts} /. 
            Options[MakeBevelGear3D]; 
cnt =  
          Append[center, 0]; 
cnt + # & /@ 
          Which[orient === XAxis, 
            makeXBevelgear[arg, mag, rad, teeth, ang, toothHt, thckness, 
              grstyle], orient === YAxis, 
            makeYBevelgear[arg, mag, rad, teeth, ang, toothHt, thckness, 
              grstyle], orient === ZAxis, 
            makeZBevelgear[arg, mag, rad, teeth, ang, toothHt, thckness, 
              grstyle]]
]

The Rotation Function

The axis of rotation is determined by the orientation of the gear, but we still need different matrices for the different rotations. Thus we define three matrices which we use in defining the RotateGear function.

xRotMat[
        t_]  :=  {{1, 0, 0, 0}, {0, Cos[t], -Sin[t], 0}, {0, Sin[t], 
          Cos[t], 0}, {0, 0, 0, 1}}

yRotMat[
        t_] := {{Cos[t], 0, -Sin[t], 0}, {0, 1, 0, 0}, {Sin[t], 0, 
          Cos[t], 0}, {0, 0, 0, 1}}

zRotMat[
        t_]  :=  {{Cos[t], -Sin[t], 0, 0}, {Sin[t], Cos[t], 0, 0}, {0, 
          0, 1, 0}, {0, 0, 0, 1}}

RotateBevelGear3D::usage  =  "RotateGear3D[rotation angle, arg, \
abs, radius, teeth,ang, tooth-height, thickness, center, opts] creates a \
function for use with ParametricPlot3D to animate gears. The first argument \
specifies how far the gear has rotated from the default position and the rest \
of the arguments are the same as those for MakeGear3D.";

RotateBevelGear3D[rotationAng_, arg_Symbol, mag_Symbol, rad_?NumericQ, 
        teeth_Integer, ang_ /; -π/2 < ang < π/2, 
        toothHt_?NumericQ, thckness_?NumericQ, center_?VectorQ, 
        opts___?OptionQ] :=  
      Module[{orient, grstyle, 
          GSTYL}, 
orient =  GearAxel /. {opts} /. 
            Options[MakeBevelGear3D]; 
grstyle  =  GearStyle /. {opts} /. 
            Options[MakeBevelGear3D]; 
cnt =  
          Append[center, 
            0]; 
(cnt + # & /@ 
              Which[orient === XAxis, xRotMat[rotationAng] . # & /@ 
                  makeXBevelgear[arg, mag, rad, teeth, ang, toothHt, 
                    thckness, GSTYL], 
                orient === YAxis, yRotMat[rotationAng] . # & /@ 
                  makeYBevelgear[arg, mag, rad, teeth, ang, toothHt, 
                    thckness, GSTYL], 
                orient === ZAxis, zRotMat[rotationAng] . # & /@ 
                  makeZBevelgear[arg, mag, rad, teeth, ang, toothHt, 
                    thckness, GSTYL]]) /. 
          GSTYL ->  grstyle
]

bevelgearOne[r_, t_] = 
        MakeBevelGear3D[t, r, 3, 39, -π/4,  .4, 2, {1, 4, 2}, 
          GearStyle  ->  {SurfaceColor[Gray, White, 50], EdgeForm[]}, 
          GearAxel  ->  YAxis];

ParametricPlot3D[Evaluate[bevelgearOne[r, t]], {r, 0, 1}, {t, 0, 1}, 
      PlotPoints ->  {20, 180}]

rotBevelGearOne[t_, r_, i_]  = 
        RotateBevelGear3D[i, t, r, 2, 26, π/4,  .4, 1, {-1/2, 0, 0}, 
          GearStyle  ->  {SurfaceColor[Gray, White, 50], 
              EdgeForm[]}];

rotBevelGearTwo[t_, r_, i_]  = 
        RotateBevelGear3D[i, t, r, 3, 39, -π/4,  .4, 1, {2.5, 2, 0}, 
          GearAxel  ->  YAxis, 
          GearStyle  ->  {SurfaceColor[Gray, White, 50], 
              EdgeForm[]}];

Do[ParametricPlot3D[
        Evaluate[
          Join[rotBevelGearOne[t, r, 3  i/2], 
            rotBevelGearTwo[t, r, -i]]], {r, 0, 1}, {t, 0, 1}, 
        PlotPoints  ->  {20, 180}, ImageSize  ->  9 72, 
        ViewPoint -> {2.285,  -2.134,  1.294}, 
        Background -> Black, 
        TextStyle -> {FontFamily -> "Arial"}], {i, 0, 
        2 π  -  π/12, π/12}]