Is it possible to get current thickness for every Line, Polygon, Circle object in a plot?

Question

When exporting Mathematica graphics to raster formats with high resolution the common problem is that thickness for such objects as Line, Polygon (via EdgeForm[]) etc. is often specified via AbsoluteThickness instead of relative Thickness, and hence with high value of ImageSize or ImageResolution on Export these objects change their appearance in an undesired way. This thickness setting usually isn't specified as a styling directive immediately before the object itself, but can be inherited from the upper levels or a stylesheet.

Is there a way to find out CurrentValue of thickness for every object on the plot in order to be able to set appropriate relative Thickness for the object before exporting?

Answer 1

Maybe you can use a tooltip with CurrentValue? For example, here's a random graphics object:

g = Graphics[{
    Thickness[.1],
    Green,
    {
        Circle[{0,0}],
        Red,
        Line[{{0,0},{1,1}}],
        {
            Blue,
            AbsoluteThickness[1],
            Polygon[{{0,1},{1,0},{1,1}}]
        }
    }
}]

Replace every Line, Polygon and Circle object with a tooltip specifying the thickness and color:

g /. l:_Line|_Polygon|_Circle -> Tooltip[
    l,
    <|"Thickness"->Dynamic@CurrentValue["Thickness"], "Color"->Dynamic@CurrentValue["Color"]|>
]

After the replacement, each graphics primitive now has a tooltip with an association giving the thickness and color being used.

Addendum

If you want the information non-interactively, you can convert the dynamics to literals. Here is a function that does this:

showCurrentValues[g_Graphics] := Module[{nb},
    Internal`WithLocalSettings[
        nb = CreateDocument[
            ExpressionCell[
                ReplaceAll[
                    g,
                    p_Line | p_Circle | p_Polygon :> Tooltip[
                        p,
                        Dynamic @ <|
                            "EdgeThickness" -> CurrentValue[EdgeThickness],
                            "Thickness" -> CurrentValue[Thickness]
                        |>
                    ]
                ],
                "Input"
            ],
            Visible->False
        ];
        FrontEndExecute @ FrontEnd`NotebookDynamicToLiteral @ nb,

        First @ NotebookImport[nb,"Input"->"Expression"]//InputForm,

        NotebookClose[nb]
    ]
]

For your example in the comments:

showCurrentValues @ Graphics[{
    Thickness[0.01],
    EdgeForm[Thickness[0.02]],
    Polygon[{{0, 1}, {1, 0}, {1, 1}}]
}]

Graphics[{Thickness[0.01], EdgeForm[Thickness[0.02]], Tooltip[Polygon[{{0, 1}, {1, 0}, {1, 1}}], <|"EdgeThickness" -> 0.02, "Thickness" -> 0.01|>]}]