DNA Model

Purpose:

This is simply a pretty cool model that I built for 10th grade biology. This project was based on the Double Helix model by Sandor Kabai. A video of it working is below along with the sourcecode. It is displaying the both the coding and template strands, with the 3 hydrogen bonds holding the bases together, allowing for easy access when transcribing the dna.
Animation:

Sourcecode:

ani = Table[
   
   With[{k = 0.5, n = 10, run = 12, sppwr = 1.7, dia2 = 0.1, 
     dia = 0.03, dia3 = 0.076, s = 1},
    Module[{m, ser, cent, sp1, sp2, hel1, hel2},
     dna = 8 Pi*t;
     sppos = 30 Sin[t*2 Pi/1.9] - 5;
     m = Sin[Pi/n];
     ser = Table[Graphics3D[Cylinder[{
          {sepF[i, sppos, sppwr]*Sin[i 2 Pi/n + dna], 
           sepF[i, sppos, sppwr]*Cos[i 2 Pi/n + dna], i 2 m Tan[k] },
          ({Sin[i 2 Pi/n + s 2 Pi/n + dna + Pi], 
               Cos[i 2 Pi/n + s 2 Pi/n + dna + Pi], 
               i 2 m Tan[k] + s 2 m Tan[k]} - {sepF[i, sppos, sppwr]*
                Sin[i 2 Pi/n + dna], 
               sepF[i, sppos, sppwr]*Cos[i 2 Pi/n + dna], 
               i 2 m Tan[k] })*1/2 + {sepF[i, sppos, sppwr]*
             Sin[i 2 Pi/n + dna], 
            sepF[i, sppos, sppwr]*Cos[i 2 Pi/n + dna], i 2 m Tan[k] }},
         dia3]], {i, run}];
     ser1 = Table[Graphics3D[Cylinder[{
          {sepF[i, sppos, sppwr]*Sin[i 2 Pi/n + s 2 Pi/n + dna + Pi], 
           sepF[i, sppos, sppwr]*Cos[i 2 Pi/n + s 2 Pi/n + dna + Pi], 
           i 2 m Tan[k] + s 2 m Tan[k]},
          ({sepF[i, sppos, sppwr]*Sin[i 2 Pi/n + s 2 Pi/n + dna + Pi],
                sepF[i, sppos, sppwr]*
                Cos[i 2 Pi/n + s 2 Pi/n + dna + Pi], 
               i 2 m Tan[k] + s 2 m Tan[k]} - {Sin[i 2 Pi/n + dna], 
               Cos[i 2 Pi/n + dna], i 2 m Tan[k] })*1/2 + {Sin[
             i 2 Pi/n + dna], Cos[i 2 Pi/n + dna], i 2 m Tan[k] }},
         dia3]], {i, run}];
     text1 = Table[Graphics3D[Text[dnaCode[[i*2]],
         ({Sin[i 2 Pi/n + s 2 Pi/n + dna + Pi], 
              Cos[i 2 Pi/n + s 2 Pi/n + dna + Pi], 
              i 2 m Tan[k] + s 2 m Tan[k]} - {Sin[i 2 Pi/n + dna], 
              Cos[i 2 Pi/n + dna], i 2 m Tan[k] })*1/
            4 + {sepF[i, sppos, sppwr]*Sin[i 2 Pi/n + dna], 
           sepF[i, sppos, sppwr]*Cos[i 2 Pi/n + dna], 
           i 2 m Tan[k] }]], {i, run}];
     text2 = Table[Graphics3D[Text[dnaCode[[i*2 + 1]],
         ({sepF[i, sppos, sppwr]*Sin[i 2 Pi/n + s 2 Pi/n + dna + Pi], 
              sepF[i, sppos, sppwr]*
               Cos[i 2 Pi/n + s 2 Pi/n + dna + Pi], 
              i 2 m Tan[k] + s 2 m Tan[k]} - {Sin[i 2 Pi/n + dna], 
              Cos[i 2 Pi/n + dna], i 2 m Tan[k] })*1/1.5 + {Sin[
            i 2 Pi/n + dna], Cos[i 2 Pi/n + dna], 
           i 2 m Tan[k] }]], {i, run}];
     
     hbond1 = Table[Graphics3D[{
         RGBColor[0.95, 0.9, 0.2],
         Sphere[({Sin[i 2 Pi/n + s 2 Pi/n + dna + Pi], 
               Cos[i 2 Pi/n + s 2 Pi/n + dna + Pi], 
               i 2 m Tan[k] + s 2 m Tan[k]} - {Sin[i 2 Pi/n + dna], 
               Cos[i 2 Pi/n + dna], i 2 m Tan[k] })*1/2 + {Sin[
             i 2 Pi/n + dna], Cos[i 2 Pi/n + dna], i 2 m Tan[k] }, 
          0.03]
         }], {i, run}];
     hbond2 = Table[Graphics3D[{
         RGBColor[0.95, 0.9, 0.2],
         Sphere[({Sin[i 2 Pi/n + s 2 Pi/n + dna + Pi], 
               Cos[i 2 Pi/n + s 2 Pi/n + dna + Pi], 
               i 2 m Tan[k] + s 2 m Tan[k]} - {Sin[i 2 Pi/n + dna], 
               Cos[i 2 Pi/n + dna], i 2 m Tan[k] })*1/2.15 + {Sin[
             i 2 Pi/n + dna], Cos[i 2 Pi/n + dna], i 2 m Tan[k] }, 
          0.03]
         }], {i, run}];
     hbond3 = Table[Graphics3D[{
         RGBColor[0.95, 0.9, 0.2],
         Sphere[({Sin[i 2 Pi/n + s 2 Pi/n + dna + Pi], 
               Cos[i 2 Pi/n + s 2 Pi/n + dna + Pi], 
               i 2 m Tan[k] + s 2 m Tan[k]} - {Sin[i 2 Pi/n + dna], 
               Cos[i 2 Pi/n + dna], i 2 m Tan[k] })*1/1.85 + {Sin[
             i 2 Pi/n + dna], Cos[i 2 Pi/n + dna], i 2 m Tan[k] }, 
          0.03]
         }], {i, run}];
     sp1 = 
      Table[Graphics3D[{RGBColor[1, .71, 0], 
         Sphere[{sepF[i, sppos, sppwr]*Sin[i 2 Pi/n + s 2 Pi/n + dna],
            sepF[i, sppos, sppwr]*Cos[i 2 Pi/n + s 2 Pi/n + dna], 
           i 2 m Tan[k] + s 2 m Tan[k]}, dia2]}], {i, run}];
     sp2 = 
      Table[Graphics3D[{RGBColor[1, .71, 0], 
         Sphere[{sepF[i, sppos, sppwr]*
            Sin[i 2 Pi/n + s 2 Pi/n + dna + Pi], 
           sepF[i, sppos, sppwr]*Cos[i 2 Pi/n + s 2 Pi/n + dna + Pi], 
           i 2 m Tan[k] + s 2 m Tan[k]}, dia2]}], {i, run}];
     hel1 = Table[Graphics3D[{RGBColor[.33, .26, .78], Cylinder[{
           {sepF[i - 1, sppos, sppwr]*Sin[i 2 Pi/n + dna], 
            sepF[i - 1, sppos, sppwr]*Cos[i 2 Pi/n + dna], 
            i 2 m Tan[k] },
           {sepF[i, sppos, sppwr]*Sin[i 2 Pi/n + s 2 Pi/n + dna], 
            sepF[i, sppos, sppwr]*Cos[i 2 Pi/n + s 2 Pi/n + dna], 
            i 2 m Tan[k] + s 2 m Tan[k]}},
          2 dia]}], {i, run}];
     hel2 = Table[Graphics3D[{RGBColor[1, .26, 0], Cylinder[{
           {sepF[i - 1, sppos, sppwr]*Sin[i 2 Pi/n + dna + Pi], 
            sepF[i - 1, sppos, sppwr]*Cos[i 2 Pi/n + dna + Pi], 
            i 2 m Tan[k] },
           {sepF[i, sppos, sppwr]*Sin[i 2 Pi/n + s 2 Pi/n + dna + Pi],
             sepF[i, sppos, sppwr]*
             Cos[i 2 Pi/n + s 2 Pi/n + dna + Pi], 
            i 2 m Tan[k] + s 2 m Tan[k]}},
          2 dia]}], {i, run}];
     codeText = Graphics3D[Text["Code: TACAGCTGAACT", {0, 0, 3 Pi/2}]];
     cent = 
      Graphics3D[{FaceForm[Hue[0.19]], 
        Cylinder[{{0, 0, 0}, {0, 0, 4}}, 0.01]}];
     Show[ser, ser1, hbond1, hbond2, hbond3, text1, text2, sp1, sp2, 
      hel1, hel2, codeText, ImageSize -> {600, 750}, 
      ViewAngle -> Pi/40, ViewPoint -> {0, 10, 3}, 
      SphericalRegion -> True, Boxed -> False]]
    ](**EndWith*)
   , {t, 0, 1, 0.003}];