How can I plot a 2D `LayeredGraph` on a 3D plane with a MMA function

Question

In my previous question, I wanted to plot a 2-dimensional MMA LayeredGraph[...] on a 3-dimensional surface (or plane), and @KGLR answered the question in the context of the example given. With this new question, I like to go one step further and automize the code that @KGLR developed as a Mathematica function such as LayeredGraphPlot3D[...] to simply plot the layered graph of LayeredGraphPlot[...] in a 3-dimensional plane.

Given a layered graph:

ClearAll[edges];
edges = {1 -> 4, 1 -> 3, 1 -> 7, 1 -> 6, 4 -> 5, 5 -> 2, 3 -> 5, 
   5 -> 1, 2 -> 6, 6 -> 5, 2 -> 4, 2 -> 7};
LayeredGraphPlot[edges, VertexLabeling -> True, 
EdgeRenderingFunction -> (Arrow[#1, 0.1] &)]

which produces:

I tried to mimic @KGLR's answer given below:

ClearAll[vertices, layers, vcoords]
vertices = {5, 3, 4, 7, 6, 1, 2};
layers = {1, 4, 2};
vcoords = 
Thread[vertices -> 
Join @@ MapThread[
  Join[##, 2] &, {MapIndexed[CirclePoints[#2[[1]]/4, #] &, 
    layers], MapIndexed[ConstantArray[#2 - 1, #] &, layers]}]];
Show[Graphics3D[{Opacity[.1], EdgeForm[Gray], Lighting -> "Neutral", 
Gray, InfinitePlane[{0, 0, #}, {{1, 0, 0}, {1, 1, 0}}] & /@ 
Range[0, 2]}, Boxed -> False], 
Graph3D[edges, VertexCoordinates -> vcoords, VertexLabels -> "Name", 
VertexStyle -> Black, VertexSize -> Tiny, ImageSize -> Medium], 
PlotRange -> All, PlotRangePadding -> Scaled[.1], 
EdgeShapeFunction -> (Arrow[#1, 0.1] &)]

which produces:

This 3-dimensional graph is mimicking the 2-dimensional layered graph above. However, my question is to create a Mathematica function such as LayeredGraphPlot3D[...] to automatically convert a 2D layered graph into a 3D layered plane, a sample of which is shown above.

Answer 1

A function that takes a graph object drawn with the option GraphLayout -> "LayeredDigraphDrawing" as input and constructs a Graph3D object with vertices arranged in layers:

ClearAll[vCoords, faceGrids, layeredGraph3D]
vCoords[g_] := (#[[1, 1]] -> Append[#[[2]], #[[1, 2]]]) & /@ 
  Join @@ (Thread[{#, Length[#] /. {1 -> {{0, 0}}, n_ :> CirclePoints[n]}}] & /@ 
     GatherBy[{#, Last @ PropertyValue[{g, #}, VertexCoordinates]} & /@ 
       VertexList[g], Last])

faceGrids[g_] := {#, {{}, Union @ GraphEmbedding[g][[All, -1]]}} & /@ 
    Join[#, -#] & @ Most[IdentityMatrix[3]]

layeredGraph3D = Graph3D[EdgeList@#, VertexCoordinates -> vCoords[#], ##2, 
    PlotRangePadding -> Scaled[.1], 
    VertexLabels -> Placed["Name", Center], 
    FaceGrids -> faceGrids[#]] &;

Examples:

edges = {1 -> 4, 1 -> 3, 1 -> 7, 1 -> 6, 4 -> 5, 5 -> 2, 3 -> 5, 
   5 -> 1, 2 -> 6, 6 -> 5, 2 -> 4, 2 -> 7};
lgp = Graph[edges, PlotTheme -> "VintageDiagram", 
   EdgeShapeFunction -> (Arrow[#1, 0.1] &), 
   GraphLayout -> "LayeredDigraphDrawing"];

layeredGraph3D[lgp]

layeredGraph3D takes the same options as Graph3D:

layeredGraph3D[lgp, VertexSize -> Medium, EdgeStyle -> Red, 
 EdgeShapeFunction -> ({Arrowheads[{{.05, .75}}], Arrow[Tube[#, .025]]} &)]

layeredGraph3D[lgp, VertexSize -> Medium, 
 EdgeStyle -> Directive[Thick, Black], 
 EdgeShapeFunction -> ({If[#[[1, -1]] <= #[[-1, -1]], Dashed], Arrow[#1, 0.1]} &)]

layeredGraph3D[lgp, VertexSize -> Medium, 
 EdgeStyle -> {_ -> Directive[Thick, Black], 
   DirectedEdge[5, _] -> Directive[Thick, Dashed, Red]}, 
 EdgeShapeFunction -> "Arrow"]

layeredGraph3D[lgp, VertexSize -> Medium, EdgeStyle -> Black, 
 PlotRangePadding -> Scaled[.1], 
 EdgeShapeFunction -> ({Arrowheads[Large, Appearance -> "Projected"], Thick,
    Arrow[BezierCurve[{#[[1]], {#[[1, 1]], #[[1, 2]], #[[-1, 3]]}, #[[-1]]}], .1]} &), 
 Properties -> {(5 \[DirectedEdge] _) -> {EdgeStyle -> Directive[Dashed, Red]}}]

If you prefer, you can define a single function:

ClearAll[layeredGraph3Db]
layeredGraph3Db[g_, opts : OptionsPattern[]] := 
 Module[{vc = #[[1, 1]] -> Append[#[[2]], #[[1, 2]]] & /@ 
     Join @@ (Thread[{#, Length[#] /. {1 -> {{0, 0}}, 
             n_ :> CirclePoints[#[[2]]/2/n, n]}}] & /@ 
        GatherBy[{#, Last@PropertyValue[{g, #}, VertexCoordinates]} & /@ 
          VertexList[g], Last]), 
   fg = {#, {{}, Union @ GraphEmbedding[g][[All, -1]]}} & /@ 
       Join[#, -#] & @ Most[IdentityMatrix[3]]}, 
  Graph3D[EdgeList @ g, VertexCoordinates -> vc, opts, 
   PlotRangePadding -> Scaled[.1], 
   VertexLabels -> Placed["Name", Center], FaceGrids -> fg]]

layeredGraph3Db[lgp]