Mathematica: Obtaining graphics primitives and directives

问题

How do you obtain graphic primitives and directives from a Graphics object? Leonid Shifrin showed how to remove them in the post Mathematica: Removing graphics primitives. I tried applying something similar but I can't get what I want. Consider this example:

 g1 = ListPlot3D[
    {{0, -1, 0}, {0, 1, 0}, {-1, 0, 1}, {1, 0, 1}, {-1, 1, 1}},
    Mesh -> {2, 2},
    Boxed -> False,
    Axes -> False,
    ViewPoint -> {2, -2, 1},
    ViewVertical -> {0, 0, 1},
    MeshStyle -> RGBColor[0, 0.5, 0],
    BoundaryStyle -> RGBColor[1, 0.5, 0]
 ];
 g2 = ImportString[ExportString[g1, "PDF", Background -> None], "PDF"][[1]]

g2 is now a graphics object. If you look at the InputForm of g2 you will see that this graphics object is composed of Polygons and JoinedCurves. What I would like to do is able to iterate through all of the primitive objects of g2. If we try to iterate as follows

 objs = First[g2];
 Table[Head[objs[[i]]], {i, 1, Length@objs}]

we obtain

 {Thickness, Polygon, Polygon, Polygon, Polygon, Style, Style, Style, Style, 
  Style, Style, Style, Style, Style, Style, Style, Style, Style, Style, Style, 
  Style, Style, Style, Style, Style, Style, Style, Style, Style, Style, Style, 
  Style, Style, Style, Style, Style, Style, Style, Style, Style, Style, Style, 
  Style, Style, Style}

What I would like to obtain instead is a list of simple primitives, I do not want them inside Styles. Here is one attempt obtaining only the lines and colors:

 tmp1 = Cases[objs, (_JoinedCurve | _RGBColor), Infinity];
 tmp2 = DeleteCases[objs, (_Polygon | _Thickness), Infinity];
 GraphicsRow[{Graphics[tmp1], Graphics[tmp2]}]

Notice that the image on the left is drawn incorrectly. This image was generated using only JoinedCurves and RGBColors. It somehow managed to miss one color, that is why we have a black line and then the rest of lines have the other color. The other image is drawn correctly, all we did was delete all the Polygons and Thickness that appeared in there. What am I doing differently here? Shouldn't we obtain the same plots?

回答1:

I read:

What I would like to obtain instead is a list of simple primitives, I do not want them inside Styles.

You can get it just by simple replacement:

First[ g2 /. Style[expr_, opts___] :> {opts, expr} ]

Now you write:

Here is one attempt obtaining only the lines and colors

Knowing the internal structure of g2 it is simple to extract only Line objects with its colors. It is even simpler because all Lines are wrapped with Style:

tmp3 = Cases[g2, 
   Style[{lines__Line}, ___, color_RGBColor, ___] :> {color, lines}, 
   Infinity];
Graphics[tmp3]

来源：https://stackoverflow.com/questions/6400524/mathematica-obtaining-graphics-primitives-and-directives

标签

wolfram-mathematica

mathematica-8