# Show[] combines my Graphics3D objects in an undesirable way

Thanks to those (Heike, Jens, MrWizard, and R.M.) who helped me yesterday with figuring out how to plot an EM wave. Now I am running into trouble with the Show command. I am trying to combine three Graphics3D objects:

• a slab
• a grating, and
• a wave.

The wave is supposed to be comparable in size with the grating and it should fall on it from the top (like light would fall on a grating). Show puts these together as a GIANT giant slab with grating and a puny EM wave. The problem is that Mathematica puts all objects' coordinate axes origin to the same point. How can I control the relative placement and sizes of these objects in Show? My code follows:

(*
sw = slab width, sh = slab height, gw = grid width, gh =
grid height, cw = channel width, sl = slab length, EM1s =
strentgth of EM wave 1, EM1f = frequency of EM wave 1
*)

sw = 38; sh = 4; gw = 3; gh = 4; cw = 6; sl = 7 gw + 6 cw;
grating = Graphics3D[{RGBColor[0.917, 0.082, 0.478],
Cuboid[{{0, 0, sh}, {sw, gw, sh + gh}}],
Cuboid[{{0, gw + cw, sh}, {sw, 2 gw + cw, sh + gh}}],
Cuboid[{{0, 2 (gw + cw), sh}, {sw, 3 gw + 2 cw, sh + gh}}],
Cuboid[{{0, 3 (gw + cw), sh}, {sw, 4 gw + 3 cw, sh + gh}}],
Cuboid[{{0, 4 (gw + cw), sh}, {sw, 5 gw + 4 cw, sh + gh}}],
Cuboid[{{0, 5 (gw + cw), sh}, {sw, 6 gw + 5 cw, sh + gh}}],
Cuboid[{{0, 6 (gw + cw), sh}, {sw, 7 gw + 6 cw, sh + gh}}]},
Boxed -> False];
slab = Graphics3D[{RGBColor[0.101, 0.701, 0.623],
Cuboid[{0, 0, 0}, {sw, sl, sh}]}, Boxed -> False
];
EM1s = 1; EM1f = 3; x1 = 2 Pi;
pts1 = Table[{t (x1/(2 Pi)), -EM1s Sin[EM1f t (x1/(2 Pi))], 0}, {t, 0,
2 Pi, 0.03}];
pts2 = {#, 0, -#2} & @@@ pts1;
EMw1 = Graphics3D[{Thickness[0.007],
{RGBColor[0.439, 0.188, 0.627], Line[pts1]},
{RGBColor[1, 0.721, 0.039], Line[pts2]}, Thickness[0.002],
Line[{#, # {1, 0, 1}}] & /@ pts1[[;; ;; 3]],
RGBColor[1, 0.721, 0.039],
Line[{#, # {1, 1, 0}}] & /@ pts2[[;; ;; 3]]},
AxesOrigin -> {0, 0, 0}, Axes -> {True, False, False},
Ticks -> None,
AxesStyle ->
Directive[Thickness[0.0075], RGBColor[0.439, 0.188, 0.627]],
Boxed -> False];
Show[slab, grating, EMw1, Axes -> False, Boxed -> False,
ImageSize -> {400, 520}, PlotRange -> All]


-

Checking the values of plot range for the three graphics object:

 {AbsoluteOptions[slab, PlotRange], AbsoluteOptions[EMw1, PlotRange]}


you get

{{PlotRange -> {{0., 38.}, {0., 57.}, {0., 4.}}}, {PlotRange -> {{0.,
6.27}, {-0.999974, 0.999999}, {-0.999999, 0.999974}}}}


Using this information, define the rescaling transform

 rscTr = RescalingTransform[{{0, 6.27}, {-1, 1}, {-1, 1}}, {{0,
38}, {-8, 8}, {-8, 8}}]


and rescale the data for EMw1:

 rescaledPts1 = rscTr[pts1]; rescaledPts2 = rscTr[pts2];


and redraw your EMw1 with rescaled data:

 rescaledEMw1 =
Graphics3D[{Thickness[0.007], {RGBColor[0.439, 0.188, 0.627],
Line[rescaledPts1]}, {RGBColor[1, 0.721, 0.039],
Line[rescaledPts2]}, Thickness[0.002],
Line[{#, # {1, 0, 1}}] & /@ rescaledPts1[[;; ;; 3]],
RGBColor[1, 0.721, 0.039],
Line[{#, # {1, 1, 0}}] & /@ rescaledPts2[[;; ;; 3]]},
AxesOrigin -> {0, 0, 0}, Axes -> {True, False, False},
Ticks -> None,
AxesStyle ->
Directive[Thickness[0.0075], RGBColor[0.439, 0.188, 0.627]],
Boxed -> False, ImageSize -> {400, 520}]


Now,

 Show[slab, grating, rescaledEMw1]


gives

The same output from a different viewpoint:

EDIT: Alternative approach: Define corrdinates of the slab and grating directly. I use a modification of R.M.s answer to OP's previous question, and specify the coordinates of the slab and grating objects.

First, slab and grating objects with modified coordinates:

 sw = 4 Pi; sh = .5; gw = .5; gh = .5; cw = 1.; sl = 9 gw + 8 cw;
grating =  Graphics3D[{RGBColor[0.917, 0.082, 0.478], Opacity[.3],
Cuboid[{{0, 0, 0}, {sw, gw, gh}}],
Cuboid[{{0, gw + cw, 0}, {sw, 2 gw + cw, gh}}],
Cuboid[{{0, 2 (gw + cw), 0}, {sw, 3 gw + 2 cw, gh}}],
Cuboid[{{0, 3 (gw + cw), 0}, {sw, 4 gw + 3 cw, gh}}],
Cuboid[{{0, 4 (gw + cw), 0}, {sw, 5 gw + 4 cw, gh}}],
Cuboid[{{0, 5 (gw + cw), 0}, {sw, 6 gw + 5 cw, gh}}],
Cuboid[{{0, 6 (gw + cw), 0}, {sw, 7 gw + 6 cw, gh}}],
Cuboid[{{0, 7 (gw + cw), 0}, {sw, 8 gw + 7 cw, gh}}],
Cuboid[{{0, 8 (gw + cw), 0}, {sw, 9 gw + 8 cw, gh}}]},
Boxed -> False, ImageSize -> {400, 520}];
slab = Graphics3D[{RGBColor[0.101, 0.701, 0.623], Opacity[.5],
Cuboid[{0, 0, -.5}, {4 Pi, 4 Pi, 0}]}, Boxed -> False, ImageSize -> {400, 520}];


Next, a modifed version of R.M.s waves (replicating the pair of waves four times):

  Module[{w1, w2, w3, w4, w5, w6, w7, w8, colors, plot, lines},
w1[x_] := {x, 0, Sin[x]}; w2[x_] := {x, Sin[x], 0};
w3[x_] := {4 \[Pi], x, Sin[x]}; w4[x_] := {4 \[Pi] + Sin[x], x, 0};
w5[x_] := {x, 4 \[Pi], -Sin[x - Pi]};
w6[x_] := {x, 4 \[Pi] - Sin[x - Pi], 0}; w7[x_] := {0, x, Sin[x]};
w8[x_] := {Sin[x], x, 0};
colors =   Darker /@ {Blue, Orange, Blue, Orange, Blue, Orange, Blue, Orange};
{plot, lines} =
ParametricPlot3D[{w1[x], w2[x], w3[x], w4[x], w5[x], w6[x], w7[x],
w8[x]}, {x, 0, 4 \[Pi]}, Boxed -> False, AxesOrigin -> {0, 0, 0},
MaxRecursion -> 0, PlotRange -> {{-Pi, 5 Pi}, {-Pi, 5 Pi}, {-2, 2}},
BoxRatios -> {1, 1, .5},
PlotStyle -> {{Thick, Thick, Thick, Thick, Thick, Thick, Thick,
Thick}, colors}\[Transpose],
EvaluationMonitor :>
Sow[{Line[{w1[x], {x, 0, 0}}], Line[{w2[x], {x, 0, 0}}],
Line[{w3[x], {4 \[Pi], x, 0}}], Line[{w4[x], {4 \[Pi], x, 0}}],
Line[{w5[x], {x, 4 \[Pi], 0}}],
Line[{w6[x], {x, 4 \[Pi], 0}}], Line[{w7[x], {0, x, 0}}],
Line[{w8[x], {0, x, 0}}]}]] // Reap;
GraphicsRow[{Show[plot,
Graphics3D[Insert[Flatten[lines, 1], colors, 1]\[Transpose]],
ViewPoint -> {3.009, -1.348, 0.759},
ViewVertical -> {0.406, -0.398, 5.732}, Ticks -> None,
AspectRatio -> 0.75],
Show[plot, slab, grating,
Graphics3D[Insert[Flatten[lines, 1], colors, 1]\[Transpose]],
ViewPoint -> {3.009, -1.348, 0.759},
ViewVertical -> {0.406, -0.398, 5.732}, Ticks -> None,
AspectRatio -> 0.75]}, ImageSize -> 900]]


Two views of the resulting 3D graphs:

-
This solves my scaling problem but does not "detach" the two objects. Is there a way to move the wave away from the x-axis of the slab? – Rainforest Frog Feb 20 '12 at 16:05
@RainforestFrog, I think it can be done by translating the data for the two waves in y and z directions. There may be more direct ways to do it, but one manual way is to play with several parameter values for the transformation inside a Manipulate. I will try to put together a Manipulate example in a day or so. – kglr Feb 20 '12 at 21:05

Thanks for all the help received, especially to kguler. My solution is probably the most cumbersome, but it works. sw = slab width, sh = slab height, gw = grid width, gh = grid height, cw = channel width, sl = slab length, EM1s = strentgth of EM wave 1, EM1f = frequency of EM wave 1, EM2s = strength of EM wave 2, EM2f = frequency of EM wave 2

SLAB, GRATING

sw = 60; sh = 6; gw = 4; gh = 6; cw = 9; sl = 8 gw + 7 cw;
grating = Graphics3D[{RGBColor[0.917, 0.082, 0.478],
Cuboid[{{0, 0, sh}, {sw, gw, sh + gh}}],
Cuboid[{{0, gw + cw, sh}, {sw, 2 gw + cw, sh + gh}}],
Cuboid[{{0, 2 (gw + cw), sh}, {sw, 3 gw + 2 cw, sh + gh}}],
Cuboid[{{0, 3 (gw + cw), sh}, {sw, 4 gw + 3 cw, sh + gh}}],
Cuboid[{{0, 4 (gw + cw), sh}, {sw, 5 gw + 4 cw, sh + gh}}],
Cuboid[{{0, 5 (gw + cw), sh}, {sw, 6 gw + 5 cw, sh + gh}}],
Cuboid[{{0, 6 (gw + cw), sh}, {sw, 7 gw + 6 cw, sh + gh}}],
Cuboid[{{0, 7 (gw + cw), sh}, {sw, 8 gw + 7 cw, sh + gh}}]},
Boxed -> False];
slab = Graphics3D[{RGBColor[0.101, 0.701, 0.623],
Cuboid[{0, 0, 0}, {sw, sl, sh}]}, Boxed -> False
];


WAVE1

EM1s = 1; EM1f = 3; x1 = 2 Pi;
EM1pts1 =
Table[{t (x1/(2 Pi)), -EM1s Sin[EM1f t (x1/(2 Pi))], 0}, {t, 0,
2 Pi, 0.03}];
EM1pts2 = {#, 0, -#2} & @@@ EM1pts1;
rscTr1 = RescalingTransform[{{0., 6.27}, {-1., 1.}, {-1., 1.}}, {{0.,
38.}, {-8., 8.}, {-8., 8.}}];
EM1rescaledPts1 = rscTr1[EM1pts1]; EM1rescaledPts2 = rscTr1[EM1pts2];
nEMw1 = {Thickness[0.007], {RGBColor[0.439, 0.188, 0.627],
Line[EM1rescaledPts1]}, {RGBColor[1, 0.721, 0.039],
Line[EM1rescaledPts2]}, Thickness[0.002],
Line[{#, # {1, 0, 1}}] & /@ EM1rescaledPts1[[;; ;; 3]],
RGBColor[1, 0.721, 0.039],
Line[{#, # {1, 1, 0}}] & /@ EM1rescaledPts2[[;; ;; 3]]};
tEMw1 = {Translate[nEMw1, {{-25, 48, 30}}]};
trEMw1 = Graphics3D[Rotate[tEMw1, 30 Degree, {0, 1, 0}]];


WAVE2

EM2s = 1; EM2f = 1; x2 = 4 Pi;
EM2pts1 =
Table[{t (x2/(2 Pi)), -EM2s Sin[EM2f t (x2/(2 Pi))], 0}, {t, 0,
2 Pi, 0.03}];
EM2pts2 = {#, 0, -#2} & @@@ EM2pts1;
rscTr2 = RescalingTransform[{{0., 6.27}, {-1., 1.}, {-1., 1.}}, {{0.,
38.}, {-8., 8.}, {-8., 8.}}];
EM2rescaledPts1 = rscTr2[EM2pts1]; EM2rescaledPts2 = rscTr2[EM2pts2];
nEMw2 = {Thickness[0.007], {RGBColor[0.498, 0.819, 0.231],
Line[EM2rescaledPts1]},
{RGBColor[0.917, 0.082, 0.478], Line[EM2rescaledPts2]},
Thickness[0.002],
Line[{#, # {1, 0, 1}}] & /@ EM2rescaledPts1[[;; ;; 3]],
RGBColor[0.917, 0.082, 0.478],
Line[{#, # {1, 1, 0}}] & /@ EM2rescaledPts2[[;; ;; 3]]};
tEMw2 = {Translate[nEMw2, {{40, 48, -5}}]};
trEMw2 = Graphics3D[Rotate[tEMw2, -30 Degree, {0, 1, 0}]];

Show[slab, grating, trEMw1, trEMw2, Axes -> False, Boxed -> False,
ImageSize -> {400, 520}, PlotRange -> All]


I am still working on making it look better, but currently it looks like something like the following.

-

You could use Rotate, Scale and Translate to position the wave. By using Manipulate you can play around with the positioning until you're happy, and then post a screenshot using the option button in the upper right corner of the panel.

sw = 38; sh = 4; gw = 3; gh = 4; cw = 6; sl = 7 gw + 6 cw;
grating =
Graphics3D[{
RGBColor[0.917, 0.082, 0.478],
Table[
Cuboid[{{0, i (gw + cw), sh}, {sw, (i + 1) gw + i cw, sh + gh}}],
{i, 0, 6}]
}, Boxed -> False];
slab = Graphics3D[{RGBColor[0.101, 0.701, 0.623],
Cuboid[{0, 0, 0}, {sw, sl, sh}]}, Boxed -> False];
EM1s = 1; EM1f = 3; x1 = 2 Pi;
pts1 = Table[{t (x1/(2 Pi)), -EM1s Sin[EM1f t (x1/(2 Pi))], 0}, {t, 0,
2 Pi, 0.03}];
pts2 = {#, 0, -#2} & @@@ pts1;
EMw1 = Graphics3D[{Thickness[0.007], {RGBColor[0.439, 0.188, 0.627],
Line[pts1]}, {RGBColor[1, 0.721, 0.039], Line[pts2]},
Thickness[0.002], Line[{#, # {1, 0, 1}}] & /@ pts1[[;; ;; 3]],
RGBColor[1, 0.721, 0.039],
Line[{#, # {1, 1, 0}}] & /@ pts2[[;; ;; 3]]},
AxesOrigin -> {0, 0, 0}, Axes -> {True, False, False},
Ticks -> None,
AxesStyle ->
Directive[Thickness[0.0075], RGBColor[0.439, 0.188, 0.627]],
Boxed -> False];

Manipulate[
DynamicModule[{vec, rot, cr},
vec = {Cos[phi] Sin[theta], Sin[phi] Sin[theta], Cos[theta]};
cr = Cross[{1, 0, 0}, vec];
If[N[Norm[Normalize[cr]]] === 0., cr = {0, 0, 1}];
rot = {0, Sin[roll], Cos[roll]};
Show[slab, grating, Graphics3D[Translate[Scale[
Rotate[Rotate[EMw1[[1]], roll, {1, 0, 0}],
VectorAngle[{1, 0, 0}, vec], cr, { x1/2, 0, 0}],
scale  sw x1/(2 Pi)^2, {0, 0, 0}], {sw, sl, sw } {x, y, z}]],
Axes -> False, Boxed -> False, ImageSize -> {400, 520},
PlotRange -> All]],
{{roll, 0}, -Pi, Pi},
{{phi, 0}, -Pi, Pi},
{{theta, Pi/2}, 0, Pi},
{{x, 0}, -1, 1},
{y, 0, 1},
{z, 0, 1},
{{scale, 1}, 0.1, 2}]


-