14

Consider the following code:

g=Graphics[{EdgeForm[{Black, Thick}],
            {Green,Opacity[0.5],Rectangle[{0,0.5},{1,1}]},
            Red, Polygon[{{0, 0}, {1, 0}, {1/2, Sqrt[3]/2}}],
            White, Disk[{1/2, 1/(2Sqrt[3])}, 1/(2Sqrt[3])]},
           Background->None];
Graphics3D[{{Texture[g],
             Polygon[{{0,0,0},{0,1,0},{1,1,0},{1,0,0}},
                     VertexTextureCoordinates->{{0,0},{1,0},{1,1},{0,1}}]},
            {Texture[g],
             Polygon[{{0,0,1},{0,1,1},{1,1,1},{1,0,1}},
                     VertexTextureCoordinates->{{0,0},{1,0},{1,1},{0,1}}]}},
           Lighting->{{"Ambient", White}},
           ViewPoint->{1,4,7}]

This gives the following graphics:

Mathematica graphics

As you can easily see, the part outside of the figures is opaque white, despite of the Background->None option. Also Background->RGBColor[1,1,1,0] didn't help, nor did passing the Graphics through Rasterize with the option Background->None

Here's roughly what I'd want to get (any inaccuracies are caused by my lacking GIMP-fu :-)):

What I would want it to look like

Looking for a solution I found this code but couldn't get it work for my case. Also, if I understand it correctly, it doesn't derive the transparency from the graphics but just replaces a certain colour with fully transparent, which wouldn't work with the semi-transparent green rectangle.

Combining the 2D graphics with another one using Show does respect Background->None and Opacity on the green rectangle, so it's not a problem with the graphics itself.

Therefore my question: Is it possible to embed 2D graphics into 3D while keeping the transparency of the 2D image, and if so, how?

Community
  • 1
celtschk
  • 19,133
  • 1
  • 51
  • 106

3 Answers3

7

OK, I've now found the solution. The trick is to extract the data from the raster and pass it to the texture directly (for some reason I also have to reverse the list to get the same result):

gtexture=Texture[Rasterize[g, Background -> None][[1,1]]/255 //Reverse];
Graphics3D[{{gtexture,
             Polygon[{{0, 0, 0}, {0, 1, 0}, {1, 1, 0}, {1, 0, 0}},
                   VertexTextureCoordinates->{{0, 0}, {1, 0}, {1, 1}, {0, 1}}]},
            {gtexture,
             Polygon[{{0, 0, 1}, {0, 1, 1}, {1, 1, 1}, {1, 0, 1}},
                   VertexTextureCoordinates->{{0, 0}, {1, 0}, {1, 1}, {0, 1}}]}},
           Lighting -> {{"Ambient", White}},
           ViewPoint -> {1, 4, 7}]

This gives the desired result:

result

celtschk
  • 19,133
  • 1
  • 51
  • 106
  • Update for v12.3: as far as I can tell, using just gtexture = Texture[Rasterize[g, Background -> None]] will do the trick – smörkex Dec 18 '21 at 17:58
6

Here is a solution partially based on this blog post. I needed to change some of your definitions, but I think the following should work. First, define a function that does some things for us:

to3d[plot_, height_, opacity_] := Module[{newplot}, newplot = First@Graphics[plot]; 
  newplot = N@newplot 
    /. {x_?AtomQ, y_?AtomQ} :> {x, y, height} 
    /. Disk[x_, y_] :> Cylinder[{x, x + {0, 0, 0.001}}, y];
  newplot /. GraphicsComplex[xx__] -> {Opacity[opacity], GraphicsComplex[xx]}]

Define your shapes separately now:

r = Graphics[{EdgeForm[{Black, Thick}], {Green, Opacity[0.5], 
     Polygon[{{0, 1}, {0, 0.5}, {1, 0.5}, {1, 1}}]}}, 
   Background -> None];
t = Graphics[{EdgeForm[{Black, Thick}], Red, 
    Polygon[{{0, 0}, {1, 0}, {1/2, Sqrt[3]/2}}], White, 
    Disk[{1/2, 1/(2 Sqrt[3])}, 1/(2 Sqrt[3])]}, Background -> None];

(Note the changed Rectangle -> Polygon definition. Polygon is valid for both 2D and 3D). Put everything together:

Graphics3D[{to3d[r, 1, 0.5], to3d[t, 1.01, 0.5], to3d[r, 0, 0.5], 
   to3d[t, .01, 0.5]}, Lighting -> "Neutral"]

Giving: Mathematica graphics

tkott
  • 4,939
  • 25
  • 44
  • Note, I'm not sure the GraphicsComplex part of the to3d function is necessary, but it works with it in, so I just left it. – tkott Oct 04 '12 at 20:13
5

Here's... an approach:

g = Graphics[{EdgeForm[{Black, Thick}], {Green, Opacity[0.5],
     Rectangle[{0, 0.5}, {1, 1}]}, Red, 
    Polygon[{{0, 0}, {1, 0}, {1/2, Sqrt[3]/2}}], White, 
    Disk[{1/2, 1/(2 Sqrt[3])}, 1/(2 Sqrt[3])]}];

lifted = N[g] /. {
    {x_Real, y_Real} :> {z, y, x},
    Rectangle :> Cuboid,
    Disk :> Sphere};

zlevelI = 0;
zlevel[] := (zlevelI = zlevelI + .001);

Show[
 Graphics3D @@ (lifted /. z :> 1 + zlevel[]),
 Graphics3D @@ (lifted /. z :> 0 + zlevel[])]

enter image description here

You get the idea. It appears to be... moderately generalizable:

g = Graphics[{EdgeForm[{Black, Thick}], {Green, Opacity[0.5],
     Rectangle[{0, 0.5}, {1, 1}]}, Red, 
    Polygon[{{0, 0}, {1, 0}, {1/2, Sqrt[3]/2}}], White, 
    Disk[{1/2, 1/(2 Sqrt[3])}, 1/(2 Sqrt[3])]}];

g2 = Plot[{Sin[x*2], Sin[4 x], Sin[6 x]}, {x, 0, Pi/2}, 
   PlotStyle -> Thick];

lift = {
   {x_Real, y_Real} :> {z, y, x},
   Rectangle :> Cuboid,
   Disk :> Sphere};

lifted = N[g] /. lift;
lifted2 = N[g2] /. lift;

zlevelI = 0;
zlevel[] := (zlevelI = zlevelI + .001);

Show[
 Graphics3D @@ (lifted /. z :> 1 + zlevel[]),
 Graphics3D @@ (lifted2 /. z :> 0)]

enter image description here

But it's definitely not ideal.

amr
  • 5,487
  • 1
  • 22
  • 32
  • The Disk→Sphere replacement is visibly wrong. Maybe a Tube would be a better option. But a similar stacking done by hand I've indeed used as workaround (but using Polygon objects in 3D). As you say, it's not ideal. If you make the z stacking too large (for sufficiently complex pictures), it can get visible, while if you make it too small, you may get artefacts from rounding errors. And of course you are limited to certain perspectives (though that was not a problem in my application). Anyway, the automated calculation of the z stacking is an interesting solution. +1. – celtschk Oct 04 '12 at 19:45
  • Yea I was just trying to get the idea across. The Sphere is there for lollerskates and a proper z-ordering would require a more involved replacement. E.g. capturing obj_[coords_] :> to apply a uniform Z to the object as a whole instead of iterating on each coordinate. – amr Oct 04 '12 at 20:17