Converting a Sierpinski tetrahedron to a Graph

A natural and simple way to approach this problem, assuming that your SiPyramid function has been defined, is as follows:

g = SiPyramid[1, {1, 1, 1}];
vertices = Union[g /. Tetrahedron[{vv__}] -> vv];
edges = Flatten[g /. Tetrahedron[vv_] :> 
  UndirectedEdge @@@ Subsets[vv, {2}]];
Graph3D[vertices, edges, VertexCoordinates -> vertices]

Unfortunately, this doesn't work for levels 2 and up. The reason is that vertices that appear where two fundamental tetrahedra intersect appear twice and the two copies are generated by different procedures. The procedures are algebraically equivalent but yield slightly different results numerically. We can demonstrate this by counting the number of vertices at level two:

g = SiPyramid[2, {1, 1, 1}];
vertices = Union[g /. Tetrahedron[{vv__}] -> vv];
vertices // Length

(* Out: 36 *)

If we perform the Union with a less stringent SameTest, we find that there are actually only 34 vertices:

Union[vertices, SameTest -> (Norm[#1 - #2] < 0.001 &)] // Length

(* Out: 34 *)

What we need is a tool to merge equivalent vertices. This is a common geometrical problem when precise connectivity information is needed. A similar problem arises in this tiling problem and we can use the same solution:

Needs["HierarchicalClustering`"]
canonicalFunction[nonCanonicalValues_List] := Module[
      {heirarchy, MyClusters, segregate, cf, clusters, 
    canonicalValues},
      Quiet[heirarchy = Agglomerate[N[nonCanonicalValues],
              DistanceFunction -> EuclideanDistance,
              Linkage -> "Average"]];
      segregate[Cluster[cl1_, cl2_, d_, _, _], tol_] :=   
    MyClusters[cl1, cl2] /; d > tol;
      segregate[mine_MyClusters, tol_] := 
    segregate[#, tol] & /@ mine;
      segregate[x_, _] := x;
      cf[cl_Cluster] := ClusterFlatten[cl];
      cf[x_] := {x};
      clusters = cf /@ 
     List @@ Flatten[FixedPoint[segregate[#, 10^(-12)] &,
                        MyClusters[heirarchy]]];
      canonicalValues = Chop[First /@ clusters];
      toCanonical[x_] := First[Nearest[canonicalValues][x]];
      toCanonical];

This canonicalFunction accepts a list of points and returns a function that transforms each of these individual points into a canonical representative. For example, given a tolerance of $0.1$, the list

{1,1.05,2,1.99,3,0.99}

could be transformed into

{1,1,2,2,3,1}

We can use it in your problem like so:

g = SiPyramid[4, {1, 1, 1}];
vertices = Union[g /. Tetrahedron[{vv__}] -> vv];
edges = Flatten[g /. Tetrahedron[vv_] :> 
  UndirectedEdge @@@ Subsets[vv, {2}]];

(* Generate the canonicalFunction *)
toCan = canonicalFunction[vertices];

(* Apply the canonicalFunction to merge vertices *)
vertices = Union[toCan /@ vertices];
edges = Map[toCan, edges, {2}];

Graph3D[vertices, edges, VertexCoordinates -> vertices]

One quick check is to generate the Graph3D without the VertexCoordinates option. In my experience, once you're missing some connectivity, the graph quickly flies apart. Using this technique, though, the topology looks correct:

Graph3D[vertices, edges]

Note that we've leveraged the fact that any expression can be a vertex. If you prefer a graph with integer indices, it is a simple matter to generate it. Here is the process for level 2.

g = SiPyramid[2, {1, 1, 1}];
vertices = Union[g /. Tetrahedron[{vv__}] -> vv];
edges = Flatten[
   g /. Tetrahedron[vv_] :> UndirectedEdge @@@ Subsets[vv, {2}]];

toCan = canonicalFunction[vertices];
vertices = Union[toCan /@ vertices];
edges = Map[toCan, edges, {2}];

(* Save the coordinates *)
vertexCoordinates = vertices;

(* Rename *)
globalCnt = 0;
newName[x_] := newName[x] = ++globalCnt;
vertices = newName /@ vertices;
edges = Map[newName, edges, {2}];

(* Draw with names *)
HighlightGraph[Graph3D[vertices, edges, VertexLabels -> "Name",
  VertexCoordinates -> vertexCoordinates],
Flatten[{1, 2, 3, 4,
  UndirectedEdge @@@ Subsets[{1, 2, 3, 4}, {2}]}]]

I suppose we could really illustrate the Graphiness of this object by illustrating a Hamiltonian path. Here it is at level 2. It's pretty easy to do with level 3 or 4 as well, but the exported animation is too large to upload to StackExchange.

{pathEdges} = FindHamiltonianCycle[g];
pathVertices = Prepend[Last /@ pathEdges, 1];
pics = Table[
   HighlightGraph[g, Join[pathVertices[[;; k]], pathEdges[[;; k]]]],
   {k, 1, Length[pathEdges]}];
Export["anim.gif", pics, "DisplayDurations" -> Append[
   Table[0.1, {Length[pathEdges] - 1}], 5],
 ImageSize -> 500]

There may be a simpler way to do this, but this function works for any object composed of Tetrahedron objects. I also made it work for MeshRegion objects of dimension 3. Expanding this to work with Polygon, Line, and Point objects should be straightforward.

tetGraph[tet3D_] := 
 With[{list = Cases[tet3D, Tetrahedron[a__] :> a]~Flatten~1},
  Graph[Range@Length@list, 
   Cases[tet3D, 
      Tetrahedron[a__] :> 
       UndirectedEdge @@@ (a[[#]] & /@ {{1, 2}, {1, 3}, {1, 4}, {2, 
            3}, {2, 4}, {3, 4}}), Infinity] /. 
     Thread[list -> Range@Length@list] // Flatten//DeleteDuplicatesBy[Sort],
   VertexCoordinates -> list]
  ]

; tetGraph[mesh_MeshRegion]:= tetGraph@MeshPrimitives[mesh,3]

tetGraph /@ {SiPyramid[2, {1, 1, 1}], SiPyramid[3, {1, 1, 1}], 
  SiPyramid[4, {1, 1, 1}]}

SeedRandom[42];
DelaunayMesh[RandomReal[{-5, 5}, {20, 3}]]
%  // tetGraph

Here's my take. The idea is similar to Mark's, except that I use ClusteringComponents[] to identify duplicate vertices, and VertexContract[] to merge those vertices together:

tetpts = N[PolyhedronData["Tetrahedron", "VertexCoordinates"], 20];
tet = Tetrahedron[tetpts];
tr = TranslationTransform /@ (tetpts/2);
makeEdge = Function @@ {MeshCells[BoundaryDiscretizeRegion[tet], 1] /. 
                        Line[l_] :> UndirectedEdge @@ Map[Slot, l]};

With[{n = 4},
     tx = Flatten[Nest[# /. Tetrahedron[pts_] :> Map[Tetrahedron[#[pts/2]] &, tr] &,
                       tet, n]];
     vc = Flatten[First /@ tx, 1]; idx = Range[4^(n + 1)];
     gt = Graph3D[idx, Flatten[makeEdge @@@ Partition[idx, 4]], VertexCoordinates -> vc];
     cl = ClusteringComponents[vc, 2 (4^n + 1), 1, Method -> "KMeans"];
     gt = Fold[VertexContract, gt, Cases[GatherBy[idx, cl[[#]] &], {_, _}]];
     gt = Graph3D[VertexList[gt], EdgeList[gt],
                  VertexCoordinates -> vc[[VertexList[gt]]], VertexSize -> Small]]