Projecting Graphics3D onto the 2D plane for vector export (and solving other issues; revisited)

Question

tl;dr:

Q: How can we turn a Graphics3D into a manageable Graphics object with only 2D graphics primitives for vector export?

A: I have came up with a partial solution which has room for improvement; scroll down to see it in a self-answer. To see remaining questions, head down to the bottom of this post.

---

There have been several questions on this subject, concerning rendering 3D graphics into vector, projecting 3D graphics onto a 2D plane, z-buffering and/or z-sorting, exporting 3D scenes, etc. etc. Here's just a small sample of such questions:

• How to export a 3D circle as a single piece PDF vectorial object?
• How to turn off depth sorting of 3D curves for Manipulate?

The above two questions stand out a bit. Exporting Graphics3D[Line[{p1,p2,p3,...}]] in vector renders rather more like line(p1,p2), line(p2,p3), line(p3, p4)... which is related to z-buffering, an effect that OP there direly wanted to disable.

• Converting 3D graphics to 2D for better export
• Exporting 2D & 3D graphics for use in Adobe Illustrator
• Export Plot3D in Mathematica 10.1 is Rasterized by default
• How can I export 3D plots as vector graphics?

There are many others which I may have missed. In particular, there is a beautiful QA which creates schematic drawings of 3D objects with hidden lines dashed, though it rasterizes the image.

Thus, lately, I have been wondering to myself, if we could somehow replicate the rendering engine of MMA and convert a Graphics3D directly into Graphics and 2D primitives.

---

Footnote:

The typical way a Graphics3D can be exported as vector is something like

Graphics[{}, Epilog -> Inset[Graphics3D[...]]]

If something complicated and/or high-poly is presented there, the resulting pdf file is huge.

---

As I have a partial solution, I have follow-up questions (this is just an incomplete subset of possible improvements):

• Can we do better than my solution (improve or rewrite completely?)
• Sphere[{x,y,z}, r] cannot be rendered in Graphics, but a straightforward conversion is /. Sphere -> Disk. What else can be done to generalize things? What can be done better?
• As an example, a uniformly-colored convex polyhedron with FaceForm[Opacity[.2]] rendered in Graphics3D will still look like it has volume. The same polyhedron, passed through my processor will look like a flat polygon with Opacity[.4]. Maybe we could adjust the colors of surfaces (polygons) depending on their normals and the view direction?

Answer 1

I came up with the following solution:

wrapper[g_Graphics3D, vp_, vv_: {0., 0., 1.}, vc_: Automatic] :=
 Module[{pr = Tuples[PlotRange[g]],
   pts = Union@Cases[g, {Repeated[_Real, {3}]}, Infinity],
   newpts, vVert, vCent, vDepth, transform, rot, rot2D, rules},
  rules = Thread[pts -> Range[Length@pts]];
  If[vc === Automatic, vCent = RegionCentroid@ConvexHullMesh@pts, 
   vCent = vc];
  vDepth = vp - vCent; newpts = pts\[Transpose] - vCent // Transpose;
  pr = pr\[Transpose] - vCent // Transpose;
  rot = RotationTransform[{vDepth, {0, -1, 0}}];
  vDepth = rot[vDepth][[2]];
  newpts = rot[newpts];
  vVert = rot[vv];
  rot2D = RotationTransform[{vVert[[{1, 3}]], {0, 1}}];
  transform = 
   Compile[{x, y, z}, {(vDepth x)/(vDepth - y), (vDepth z)/(vDepth - y)},
    RuntimeAttributes -> {Listable}];
  pr = Map[Norm, (transform @@ Transpose[rot[pr]])] // Max;
  newpts = transform @@ Transpose[newpts];
  newpts = rot2D[newpts];
  Graphics[{GraphicsComplex[newpts, First@g /. rules]}, 
   Join[{PlotRange -> {{-pr, pr}, {-pr, pr}}}, List @@ Rest[g]]]
  ]

Here it is in action. The original image is given by

im = Uncompress[Import["https://pastebin.com/raw/QHVeNCty", "String"]]

While the 2D projection can be obtained and manipulated by

Manipulate[
 wrapper[im /. {Sphere -> Disk, Tube -> (Identity[#] &), 
      h_[None] :> h[Opacity[0]]} /. FaceForm -> Identity // 
   DeleteCases[#, (PlotLabel -> _), Infinity] &, {-20, y, z}, {0, 1, 
   0}], {y, 0, 20}, {z, 0, 30}]

The way my wrapper works, is by taking a viewpoint vp (closely analogous to ViewPoint of Graphics3D, but unscaled coordinates), taking a view vertical, optionally a view center (vc, i.e. the point at which the camera is directed). Then it finding all points in the Graphics3D:

pts = Union@Cases[g, {Repeated[_Real, {3}]}, Infinity]

rotates and translates the scene, so that we project onto the xz plane and does a pinhole camera projection. A pdf export of the result is only 19KB. I'm not even trying to export the original Graphics3D to vector, but it's in the ballpark of 5MB at least.