PlotRangePadding that's a fixed fraction of a plot's longest dimension

Question

I am trying to produce plots of a region which can alternately become very long or very tall, and I would like to have some padding around it which is uniformly thick in both the horizontal and vertical directions. However, I'm having some trouble getting the correct settings for PlotRangePadding to achieve this.

More specifically, I'm trying to get a padding between my plot and the surrounding Frame that is (say) 10% of the longest dimension of my plot. This is what I might naïvely expect of a single setting fed to the option, which is meant to produce "the same padding in all directions", but giving it the corresponding setting,

Graphics[{Pink, Rectangle[{0, 0}, {1, 0.1}]}, 
    PlotRangePadding -> Scaled[0.1], Frame -> True]

produces a padding of 10% of the relevant dimension in each direction. This is not very visually pleasing, as the long coordinate has too much padding and the short coordinate has too little padding:

Is there a way to automatically achieve such a scaled uniform padding?

Note that manually setting different settings for the different directions, such as PlotRangePadding -> {Scaled[0.02], Scaled[0.2]} is not an option, as my plots are dynamically generated, and may change from 'long' to 'square' to 'tall'. The coordinate ranges can also change dramatically from the few tenths to the few hundreds in each direction, so a static padding will not work.

Answer 1

AbsoluteOptions is not always working well but you can try:

padding[s_, obj_] := With[{
          off = s Max[#2 - # & @@@ (AbsoluteOptions[#, PlotRange][[1, 2]])] &@#
          }, 
          Show[#, PlotRangePadding -> off]] &[obj]

padding[.2, Graphics[{Pink, Rectangle[{0, 0}, {1, 0.1}]}, Frame -> True]]

Answer 2

You could use image metrics to compute the padding.

uniformPad[g_, a_] := 
  With[{pad = a Max[ImageDimensions[Image[g]]]}, 
    Show[g, PlotRangePadding -> pad, Frame -> True]]

g1 = With[{extent = {1, 0.1}}, Graphics[{Pink, Rectangle[{0, 0}, extent]}]];

g2 = With[{extent = {0.25, 1}}, Graphics[{Pink, Rectangle[{0, 0}, extent]}]];

uniformPad[g1, .0001]

uniformPad[g2, .0001]