Q:

Cubes inscribed into a tetrahedron

I am trying to visualize a geometry concept by using Wolfram Mathematica. 

Here is a sample image.
I have found the source code for tetrahedron online, but I can't find a source code for inscribed cubes in a tetrahedron. 
Could anybody help me finding it?

A:

This might get you started:
T = PolyhedronData["Tetrahedron", "MeshRegion"];
Q = PolyhedronData["Cube", "BoundaryMeshRegion"];
edgepairs = DeleteDuplicates[
   Sort[{#, Complement[Range[4], #]}] & /@ Subsets[Range[4], {2}]
   ];
U = Map[
   Transpose[
     Normalize /@ {#[[1, 1]] - #[[1, 2]], #[[2, 1]] - #[[2, 
         2]], (#[[1, 1]] + #[[1, 2]]) - (#[[2, 1]] + #[[2, 2]])}] &,
   ArrayReshape[MeshCoordinates[T][[Flatten[edgepairs]]], {3, 2, 2, 3}]
   ];
ξ = Mean[MeshCoordinates[T][[2 ;; 4]]] - MeshCoordinates[T][[1]];
pts = Transpose[U.Transpose[MeshCoordinates[Q]], {1, 3, 2}];
pts *= (ξ.MeshCoordinates[T][[4]]/Max[pts.ξ]);
cubelist = MapIndexed[
   MeshRegion[
     #,
     Hexahedron[{{1, 3, 4, 2, 5, 7, 8, 6}}],
     PlotTheme -> "SphereAndTube"
     ] &,
   pts
   ];

And here a plot:
cols = ColorData[97] /@ {1, 3, 4};
θ = 0.0075;
Show[
 Graphics3D[{
   Specularity[White, 30],
   Blend[{White, cols[[1]]}, .5],
   Opacity[.2],
   MeshPrimitives[T, 3],

   Opacity[1],
   Gray,
   MeshPrimitives[T, 1] /. Line[x_] :> Tube[x, θ],
   MeshPrimitives[T, 0] /. Point[x_] :> Sphere[x, 2 θ],
   Riffle[
    cols, 
    MeshPrimitives[#, 1] & /@ cubelist /. Line[x_] :> Tube[x, θ]],
   Riffle[
    cols, 
    MeshPrimitives[#, 0] & /@ cubelist /. Point[x_] :> Sphere[x, 2 θ]]
   }],
 Lighting -> "Neutral",
 Boxed -> False,
 PlotRange -> All,
 SphericalRegion -> True
 ]

