Issue with ImageCrop and Rasterize

Question

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

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]

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)"

What about choosing a larger ImageSize for the rasterized version? Might be the quickest fix... — Yves Klett, Dec 01 '15 at 18:11
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. — george2079, Dec 01 '15 at 18:30

score 2 · Accepted Answer · edited Apr 13 '17 at 12:55

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]

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.

Issue with ImageCrop and Rasterize

1 Answers1