7
$\begingroup$

Here's a pretty red arrow:

arrow = Graphics3D[{Red, Arrowheads[.25], Arrow[Tube[{{0, 0, 0}, {1, 1, 1}}, .04]]} ]
Export[StringJoin[NotebookDirectory[], "arrow.pdf"], arrow]

zoomedOutRedArrow

As you can see, I exported it as a pdf, so it is vectorized [*]. So because its a pdf, I should be able to zoom in a lot, right? Unfortunately for me, the answer is no:

zoomed in red arrow

Look at all those pixels! Please, how can I make it so that this arrow can be zoomed in upon really close? What about the box line right next to it?

Edit: I'm trying to get the mesh from this 3D spherical plot to work better also. I assume that what fixes the arrow will fix the mesh also. Let me know if I should expand this question.

Edit 2: Looks like the answer is here Does that make this a duplicate?

[*] I can't upload vector graphics here, so I took a screen shot. I assure that it looks just as crappy in inkscape. Also, I tried SVG - same issue.

$\endgroup$
  • $\begingroup$ At least on macos, one can do the following: Right-click on the displayed graphic in the notebook and select "Print Graphic...". In the opening print dialog, go to "PDF" in the lower left corner and select "Save as PDF". Et voilà: The resulting pdf contains a vector graphic. It still contains some not so nice artifacts... (I opened it in inkscape and was able to edit it.) @halirutan might also be interested. $\endgroup$ – Henrik Schumacher Jan 16 '18 at 2:22
5
$\begingroup$

I know of no built-in method for exporting 3D plots to vector graphics. However, I found some Mathematica code for a self-written vector renderer with Lambert shading in the deeps of my hard drive. I tried to adapt it to use as few specialized functions as possible; this is why I redirect a certain task (finding neigboring triangles of edges in a two-dimensional simplicial complex ) to the IGraph/M package by Szabolcs.

Needs["IGraphM`"];

cCross3 = With[{},
   Compile[{{X, _Real, 1}, {Y, _Real, 1}},
    {
     -X[[3]] Y[[2]] + X[[2]] Y[[3]], 
      X[[3]] Y[[1]] - X[[1]] Y[[3]], 
     -X[[2]] Y[[1]] + X[[1]] Y[[2]]
    },
    CompilationTarget -> "C",
    RuntimeAttributes -> Listable,
    Parallelization -> True
    ]
   ];

ClearAll[VectorRenderer]
VectorRenderer[M_MeshRegion, OptionsPattern[{
    "Position" -> {0, 0, -10},
    "LookAt" -> {0, 0, 0},
    "Sky" -> {0, 1, 0},
    "LightSource" -> {6, 4, -10},
    "EdgeThickness" -> 0.0005,
    "EdgeColor" -> Automatic,
    "AmbientLight" -> 0.3,
    "Color" -> Lighter@RGBColor[0.0745, 0.176, 0.415],
    "Background" -> None
    }]] :=
 Module[{meanfun,
   eye, direction, ambient, lightsource,
   w, u, v, pts, triangles, trianglepts, trianglemidpts, 
   visibletriangles, triangledistances,
   in, out, p1, p2, p3, trianglenormals, cosα, cosθ, 
   lambertintensities, intensities, cols, p, newp, visiblecolors,
   edges, edgepts, edgemidpts, edgeneightriangles, visibleedges, 
   edgedistances, edgeintensities, edgecols, visibleedgescols,
   ordering
   },
  eye = N@OptionValue["Position"];
  direction = N@OptionValue["LookAt"] - eye;
  ambient = N@OptionValue["AmbientLight"];
  lightsource = N@OptionValue["LightSource"];

  meanfun = Compile[{{x, _Real, 2}}, Mean[x],
    RuntimeAttributes -> {Listable},
    Parallelization -> True
    ];
  w = Normalize[direction];
  v = Normalize[N[OptionValue["Sky"]]];
  u = Cross[w, v];
  pts = MeshCoordinates[M];
  triangles = Developer`ToPackedArray[MeshCells[M, 2][[All, 1]]];
  trianglepts = Partition[pts[[Flatten[triangles]]], 3];
  trianglemidpts = meanfun[trianglepts];
  visibletriangles = Range[Length[triangles]];
  triangledistances = Sqrt[Total[Subtract[
       trianglemidpts[[visibletriangles]],
       ConstantArray[eye, Length[visibletriangles]]
       ]^2, {2}]];
  in = Subtract[ConstantArray[lightsource, {Length[triangles]}], trianglemidpts];
  in /= Sqrt[Total[in^2, {2}]];
  out = Subtract[ConstantArray[eye, {Length[triangles]}], trianglemidpts];
  out /= Sqrt[Total[out^2, {2}]];
  {p1, p2, p3} = Transpose[trianglepts];
  trianglenormals = cCross3[p2 - p1, p3 - p1];
  trianglenormals /= Sqrt[Total[trianglenormals^2, {2}]];
  cosθ = Total[Times[trianglenormals, in], {2}];
  cosα = Total[Times[trianglenormals, out], {2}];
  lambertintensities = Times[cosθ, Sign[cosα]];
  intensities = Ramp[ambient + (1. - ambient) lambertintensities];
  With[{colorvector = List @@ ColorConvert[OptionValue["Color"], RGBColor]},
   cols = Map[x \[Function] RGBColor @@ (x colorvector), intensities]
   ];
  p = pts - ConstantArray[eye, Length[pts]];
  newp = Times[Transpose[{p.u, p.v}] Norm[direction]/p.w];
  visiblecolors = cols[[visibletriangles]];
  edges = Developer`ToPackedArray[MeshCells[M, 1][[All, 1]]];
  edgepts = Partition[pts[[Flatten[edges]]], 2];
  edgemidpts = meanfun[edgepts];
  edgeneightriangles = Flatten[IGMeshCellAdjacencyMatrix[M, 1, 2]["AdjacencyLists"]];
  visibleedges = Range[Length[edges]];
  edgedistances = Sqrt[Total[Subtract[
       edgemidpts[[visibleedges]],
       ConstantArray[eye, Length[visibleedges]]
       ]^2, {2}]];
  If[OptionValue["EdgeColor"] === Automatic,
   edgecols = RGBColor @@@ Map[
      x \[Function] Mean[DeleteCases[x, List]], 
      Partition[(List @@@ cols)[[edgeneightriangles]], 2]
      ],
   edgedistances -= 0.01;
   edgeintensities = Developer`ToPackedArray@Map[
      x \[Function] Mean[DeleteCases[x, List]], 
      Partition[intensities[[edgeneightriangles]], 2]
      ];
   With[{colorvector = 
      List @@ ColorConvert[OptionValue["EdgeColor"], RGBColor]},
    edgecols = 
     Map[x \[Function] RGBColor[x colorvector], edgeintensities]
    ];
   ];
  visibleedgescols = edgecols[[visibleedges]];
  ordering = Reverse@Ordering[Join[triangledistances, edgedistances]];

  Graphics[
   Join[
     Transpose[{
       visiblecolors,
       ConstantArray[EdgeForm[], Length[visibletriangles]],
       Polygon /@ 
        Partition[newp[[Flatten[triangles[[visibletriangles]]]]], 3]
       }],
     Transpose[{
       visibleedgescols,
       ConstantArray[Thickness[OptionValue["EdgeThickness"]], 
        Length[visibleedges]],
       Line /@ Partition[newp[[Flatten[edges[[visibleedges]]]]], 2]
       }]
     ][[ordering]],
   Background -> OptionValue["Background"]
   ]
  ]

The syntax for the camera is closer to POVray's than Mathematica's, though. Moreover, VectorRenderer assumes that all 2-dimensional MeshCells of the MeshRegion handed over to it are triangular.

You can test VectorRenderer on

M = ExampleData[{"Geometry3D", "Triceratops"}, "MeshRegion"];
g = VectorRenderer[M, 
 "Position" -> {10, -10, 0}, 
 "Sky" -> {0, 0, 1}, 
 "LightSource" -> {5, 0, -10}];
Export["triceratops_lowres.pdf", g];

enter image description here

If you are willing to use Subdivide from this post, you will realize that there is some reason that vector renderers are seldomly used for 3D images: the performance for the export (and also for the rendering in the pdf viewer) is poor and it leads to humongous output files.

g = VectorRenderer[Subdivide[M], 
 "Position" -> {10, -10, 0}, 
 "Sky" -> {0, 0, 1}, 
 "LightSource" -> {5, 0, -10}
];
Export["triceratops_highres.pdf", g];

enter image description here

(This is actually a conversion of the resulting pdf to png since I cannot post pdfs here.)

If you are still willing to do this, you can use Subdivide to produce nice sphere and tubes; maybe also the tips of arrows. An alternative is to use ParametricPlot3D but that one tends to produce GraphicsComplexes with quadrilateral faces; these have to be split into triangles before sending them to VectorRenderer.

| improve this answer | |
$\endgroup$
  • $\begingroup$ You got my upvote for this, although it doesn't solve the underlying issue. What we would need is such a renderer, that takes vertex-colors, light-positions and camera of the original Graphics3D into account. Then, it should create a new mesh that removes background polygons and splits existing polygons, so that the color appears to be smooth even if only one color per polygon is used. The result should be a set of 2D polygons that represent the 3D scene and combines original 3D Frame, axes, ticks. This can then be exported to PDF or SVG to create a real vector graphics. $\endgroup$ – halirutan Jan 16 '18 at 1:21
  • $\begingroup$ @halirutan Thanks. I know, I know. I tried these things several years ago for plotting low resolution polygonal surfaces for publications. But I was quite disappointed by the quality and stopped working on that. Hence, the z-buffer is quite imperfect (look at the artifacts at the horns) and occlusion is not implemented at yet, so all polygons are exported. Moreover, I draw artificial edges on top of the triangles just to hide the fact that triangles will be separated by thin white lines after pdf export. That's quite ugly. $\endgroup$ – Henrik Schumacher Jan 16 '18 at 1:32
  • $\begingroup$ @halirutan Fixing light and camera would be less an issue; for multiple color triangles, we merely had to find an appropriate export format. Do you know of any? Then also shading with vertex normals be done, at least approximately. $\endgroup$ – Henrik Schumacher Jan 16 '18 at 1:33
  • $\begingroup$ In fact, I was looking into this several times myself and was always disappointed. I basically see 2 different ways: (1) Do the 2D projection, shading, occlusion, .. yourself and create a 2D vector graphics. Then you have to struggle with how Charting` creates the ticks because without axes or frame, it won't be useful. (2) Clean up the existing Graphics3D by replacing multicolored polygons with a refined mesh and throw out background polygons. Then you could export the Graphics3D from this view position as normal and would get a vector graphics. $\endgroup$ – halirutan Jan 16 '18 at 1:43
  • $\begingroup$ However, cleaning background polygons is at least not a 5min task. But option (2) is definitely less work than reimplementing a renderer. I read through several format specs and was mainly interested in SVG, but it lacks of the colored polygons-vertices. There seem to be a PDF 3D project but my feeling is that it is abandoned. $\endgroup$ – halirutan Jan 16 '18 at 1:45
4
$\begingroup$
arrow = Graphics3D[
   {Red, 
    Arrowheads[.25], 
    Arrow[Tube[{{0, 0, 0}, {1, 1, 1}}, .04]]},
    ImageSize -> 2000];

works perfectly.

enter image description here

| improve this answer | |
$\endgroup$
  • 1
    $\begingroup$ No, it is not a better option to use an extreme resolution to fight the missing vector-graphics export. It is merely a way around this issue which, btw, doesn't start with Mathematica. It begins that famous formats like SVG don't have a way to represent polygons with different colors for each vertex. It goes on that earlier versions of Mathematica exported all polygons, even the ones in the background that cannot be seen. Today, we cannot even create a Graphics3D conversion tool because there is no way to access ticks anymore, etc, etc.. I would love to see a 3rd-party package solving this. $\endgroup$ – halirutan Jan 16 '18 at 1:15
  • 1
    $\begingroup$ @halirutan: So what would be your immediate solution for the question poser? $\endgroup$ – David G. Stork Jan 16 '18 at 2:10
  • 1
    $\begingroup$ oh, I see. It is the junction of the arrow head and the shaft. Took me a bit $\endgroup$ – axsvl77 Jan 16 '18 at 2:55
  • 1
    $\begingroup$ This answer doesn't work at all. When you export it, the pdf format is not improved. It just looks better in the notebook, which is not what I'm looking for. $\endgroup$ – axsvl77 Jan 16 '18 at 19:20
  • 1
    $\begingroup$ @HenrikSchumacher Agreed. Try it; you export the pdf, zoom in. It still has the staircase. The axes are much better though $\endgroup$ – axsvl77 Jan 16 '18 at 20:14

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.