1
$\begingroup$

This is related to 1.

I use the following code:

 arrowAxes[{axesLength1_, axesLength2_, axesLength3_}, 
  arrowcolor_: Black] := {arrowcolor, Arrowheads[.05], 
  Map[Arrow[Tube[{{0, 0, 0}, #}, 0.3]] &, {axesLength1 + 0.5, 
     axesLength2 + 0.6, axesLength3 + 0.7} IdentityMatrix[3]]}
labelAxes[{axesLength1_, axesLength2_, axesLength3_}, {o1_String: "x",
    o2_String: "y", o3_String: "z"}, 
  col_: Black] := {col, {Text[
    Style[o1, 20, Italic], {axesLength1 + 0.5, 0, -0.4}], 
   Text[Style[o2, 20, Italic], {0, axesLength2 + 1, -0.4}], 
   Text[Style[o3, 20, Italic], {0.1, 0.5, axesLength3 + 0.6}]}}

ellipsoidXYZ[{a_, b_, c_}, opac1_: 0.6] := {Specularity[White, 10], 
  Blue, EdgeForm[], Opacity[opac1], Ellipsoid[{0, 0, 0}, {a, b, c}]}

axes1 = Graphics3D[{arrowAxes[{75, 75, 75}], 
    labelAxes[{80, 80, 80}, {"1", "2", "3"}]}, ImageSize -> Large];
g1 = {Graphics3D[ellipsoidXYZ[{50, 1, 50}]], axes1};
viewpoint = 1.2 {1, 1, 1};
Show[g1, Lighting -> {{"Point", White, 
    viewpoint + {0, 0, 2}}, {"Ambient", RGBColor[0.15, 0.15, 0.15]}}, 
 Boxed -> False, ViewPoint -> viewpoint]

to create

enter image description here

I want to crop the white space surrounding the figure.

I use

Rasterize[
 Show[g1, Lighting -> {{"Point", White, 
     viewpoint + {0, 0, 2}}, {"Ambient", RGBColor[0.15, 0.15, 0.15]}},
   Boxed -> False, ViewPoint -> viewpoint, ImagePadding -> None, 
  Method -> {"ShrinkWrap" -> True}], ImageResolution -> 300]

enter image description here

but the labels dissapear.

Also with

ImageCrop[
 Rasterize[
  Show[g1, Lighting -> {{"Point", White, 
      viewpoint + {0, 0, 2}}, {"Ambient", 
      RGBColor[0.15, 0.15, 0.15]}}, Boxed -> False, 
   ViewPoint -> viewpoint], ImageResolution -> 300]]

the quality of the figure is not the same.

In[143]:= $Version

Out[143]= "10.3.0 for Linux x86 (64-bit) (October 9, 2015)"
$\endgroup$
  • 1
    $\begingroup$ What about choosing a larger ImageSize for the rasterized version? Might be the quickest fix... $\endgroup$ – Yves Klett Dec 1 '15 at 18:11
  • 1
    $\begingroup$ the last case looks fine to me with 10.1. Oddly increasing the resolution to 600 gives a completely black raster. In any case one thing to try is export to a raster format and read it back in. $\endgroup$ – george2079 Dec 1 '15 at 18:30
2
$\begingroup$

I have often used this function to crop images.

 cropGraphics[g_, x_, y_, w_, h_] := 
   Graphics[Inset[g, {x, y}, {0, 0}], PlotRange -> {{0, 1}, {0, 1}}, 
   ImageSize -> {w, h}, ImagePadding -> None, AspectRatio -> Full];

  g2 = Show[g1, 
  Lighting -> {{"Point", White, viewpoint + {0, 0, 2}}, {"Ambient", 
  RGBColor[0.15, 0.15, 0.15]}}, Boxed -> False, 
  ViewPoint -> viewpoint];

Playing around a while with the coordinates, you can easily remove all surrounding white space.

  res = cropGraphics[g2, -0.08, -0.37, 128, 130];
  Export["image.jpg", res, ImageResolution -> 600]

enter image description here

Note: In the final image I observed some overlap of the axes label 3 with the arrow so I changed the labelAxes[{80, 80, 84}... to avoid any overlap.

$\endgroup$

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.