6
$\begingroup$

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]

enter image description here

$\endgroup$

3 Answers 3

4
$\begingroup$

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

pict1

The same output from a different viewpoint:

pict2

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:

view 1

view 2

$\endgroup$
2
  • $\begingroup$ 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? $\endgroup$ Commented Feb 20, 2012 at 16:05
  • $\begingroup$ @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. $\endgroup$
    – kglr
    Commented Feb 20, 2012 at 21:05
3
$\begingroup$

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.

enter image description here

$\endgroup$
3
$\begingroup$

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}]

Mathematica graphics

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.