AbsoluteOptions
is known as very buggy function and the bug in determining the true PlotRange
has very long history...
You could try my Ticks
-based workaround for getting the complete PlotRange
(with PlotRangePadding
added):
completePlotRange[plot:(_Graphics|_Graphics3D|_Graph)] :=
Last@
Last@Reap[
Rasterize[
Show[plot, Axes -> True, Frame -> False, Ticks -> ((Sow[{##}]; Automatic) &),
DisplayFunction -> Identity, ImageSize -> 0], ImageResolution -> 1]]
Manipulate[
DynamicModule[{pic},
Column[{pic =
Graphics[{FaceForm[], EdgeForm[Black],
GeometricTransformation[Rectangle[], RotationTransform[a]],
Red, Point[p]}, Frame -> True, PlotRangePadding -> 0], p,
AbsoluteOptions[pic, PlotRange], completePlotRange[pic]}]], {{a,
4}, 0, 2 Pi}, {{p, {.1, -.6}}, {-2, -2}, {2, 2}, Locator},
ContinuousAction -> False, SynchronousUpdating -> False]

EDIT
One can get the exact PlotRange
(without the PlotRangePadding
added) with the following function:
plotRange[plot : (_Graphics | _Graphics3D | _Graph)] :=
Last@
Last@Reap[
Rasterize[
Show[plot, PlotRangePadding -> None, Axes -> True, Frame -> False,
Ticks -> ((Sow[{##}]; Automatic) &), DisplayFunction -> Identity, ImageSize -> 0],
ImageResolution -> 1]]
Manipulate[
DynamicModule[{pic},
Column[{pic =
Graphics[{FaceForm[], EdgeForm[Black],
GeometricTransformation[Rectangle[], RotationTransform[a]],
Red, Point[p]}, Frame -> True], p,
AbsoluteOptions[pic, PlotRange], plotRange[pic]}]], {{a, 4}, 0,
2 Pi}, {{p, {.1, -.6}}, {-2, -2}, {2, 2}, Locator},
SynchronousUpdating -> False]

EDIT 2
Here is timing comparison of various ways to get real PlotRange
:
completePlotRange[plot : (_Graphics | _Graphics3D | _Graph)] :=
Last@
Last@Reap[
Rasterize[
Show[plot, Axes -> True, Frame -> False, Ticks -> ((Sow[{##}]; Automatic) &),
DisplayFunction -> Identity, ImageSize -> 0], ImageResolution -> 1]]
completePlotRange[plot : (_Graphics | _Graphics3D | _Graph), format_] :=
Last@
Last@Reap[
ExportString[
Show[plot, Axes -> True, Frame -> False, Ticks -> ((Sow[{##}]; Automatic) &),
DisplayFunction -> Identity, ImageSize -> 0], format]]
pic = Graphics[{FaceForm[], EdgeForm[Black],
GeometricTransformation[Rectangle[], RotationTransform[.3]]},
Frame -> True];
Print[{#,
AbsoluteTiming[
First@Table[
completePlotRange[pic, #], {100}]]}] & /@ {"RawBitmap", "BMP",
"WMF", "EMF", "SVG", "PDF", "EPS"};
{RawBitmap,{2.8931655,{{-0.32158,0.981396},{-0.0250171,1.27587}}}}
{BMP,{3.0201728,{{-0.32158,0.981396},{-0.0250171,1.27587}}}}
{WMF,{4.3242473,{{-0.32158,0.981396},{-0.0250171,1.27587}}}}
{EMF,{4.0182298,{{-0.32158,0.981396},{-0.0250171,1.27587}}}}
{SVG,{3.1461800,{{-0.32158,0.981396},{-0.0250171,1.27587}}}}
{PDF,{16.9799712,{{-0.32158,0.981396},{-0.0250171,1.27587}}}}
{EPS,{7.3074179,{{-0.32158,0.981396},{-0.0250171,1.27587}}}}
AbsoluteTiming[First@Table[completePlotRange[pic], {100}]]
{2.3991372, {{-0.32158, 0.981396}, {-0.0250171, 1.27587}}}
One can see that Rasterize
with ImageSize -> 0
is the fastest.
UPDATE 3
Here is purely Dynamic
implementation of the same idea:
plotRange[plot : (_Graphics | _Graphics3D | _Graph)] :=
Reap[NotebookDelete[
First@{PrintTemporary[
Show[plot, Axes -> True, Frame -> False,
Ticks -> ((Sow[{##}]; Automatic) &),
DisplayFunction -> Identity, PlotRangePadding -> None,
ImageSize -> 0]], FinishDynamic[]}]][[2, 1]]
completePlotRange[plot : (_Graphics | _Graphics3D | _Graph)] :=
Reap[NotebookDelete[
First@{PrintTemporary[
Show[plot, Axes -> True, Frame -> False,
Ticks -> ((Sow[{##}]; Automatic) &),
DisplayFunction -> Identity, ImageSize -> 0]],
FinishDynamic[]}]][[2, 1]]
AbsoluteOptions
$\endgroup$ – ssch Jan 18 '13 at 21:01AbsoluteOptions
orGeometricTransformation
. After all the latter one has records too. $\endgroup$ – Silvia Jan 18 '13 at 21:04AbsoluteOptions
had several problems withPlotRange
andTicks
(at least). $\endgroup$ – Dr. belisarius Jan 18 '13 at 21:34PlotRange
? $\endgroup$ – Silvia Jan 18 '13 at 21:37GeometricTransformation
is relevant here? In my understanding, the problem boils down to this simple example which returns wrong values:g = Graphics[{}, Frame -> True]; Print[g]; AbsoluteOptions[g, PlotRange]
. I hope you don't mind that I added this to your Q to make it more general, if so, please feel free to revert. $\endgroup$ – István Zachar Sep 10 '13 at 9:09