9
$\begingroup$

I am trying to draw this figure.

enter image description here

I tried

Graphics3D[{Polygon[{{-3, -3, -2}, {-3, 3, -2}, {3, 
     3, -2}, {3, -3, -2}}]}, Boxed -> False]

enter image description here

$\endgroup$
2
  • $\begingroup$ Are you looking for the projection of this polygon into the coordinate planes? $\endgroup$ Nov 8, 2023 at 9:06
  • $\begingroup$ You can do like that. $\endgroup$ Nov 8, 2023 at 10:24

2 Answers 2

13
$\begingroup$
Clear["Global`*"];
{u1, u2} = {{0, 1, 0}, {0, 0, 1}};
pt1 = {0, 0, 2};
plane1 = InfinitePlane[pt1, {u1, u2}];
c1[t_] := pt1 + {Cos[t], Sin[t]} . {u1, u2};
{v1, v2} = {{1, 0, 0}, {0, 1, 0}};
pt2 = {0, 0, 0};
plane2 = InfinitePlane[pt2, {v1, v2}];
dir = {1, 0, 0} - {0, 0, 1};
sol = Solve[c1[t] + s*dir ∈ plane2, s, Reals][[1]];
c2[t_] := c1[t] + s*dir /. sol[[1]];
{{p1, p2, p3, p4}, {q1, q2, q3, q4}} = 
  Transpose@
   Table[{c1[t], c2[t]}, {t, 
     1 + {0, π/2, 2 π/2, 3 π/2}}];
Show[Graphics3D[{FaceForm[], plane1, plane2}], 
 ParametricPlot3D[c1[t], {t, 0, 2 π}], 
 ParametricPlot3D[c2[t], {t, 0, 2 π}], 
 Graphics3D[{Arrowheads[.025], AbsoluteThickness[2], Blue, 
   Line[{{p1, p3}, {p2, p4}}], Line[{{q1, q3}, {q2, q4}}], Orange, 
   Arrow /@ {{p1, q1}, {p2, q2}, {p3, q3}, {p4, q4}}}], 
 PlotRange -> 4, ViewPoint -> {2.3, 0.95, 2.3}, Boxed -> False]

enter image description here

  • The idea is at first draw a spatial circle,and set a direction say ({1, 0, 0} - {0, 0, 1}), then through every points of the spatial circle we draw lines which parallel to the direction to construct a cylinder. The intersection of such cylinder and another infinite plane is the projection of such spatial circle.
e1 = {1, 0, 0};
e2 = {0, 1, 0};
e3 = {0, 0, 1};
Show[Graphics3D[{InfinitePlane[{0, 0, 0}, {e1, e2}], 
   InfinitePlane[{0, 0, 0}, {e2, e3}]}], 
 ParametricPlot3D[{0, 0, 2} + {Cos[t], Sin[t]} . {e2, e3}, {t, 0, 
   2 π}], 
 ParametricPlot3D[{0, 0, 2} + {Cos[t], Sin[t]} . {e2, e3} + 
   s*({1, 0, 0} - {0, 0, 1}), {t, 0, 2 π}, {s, -10, 10}], 
 PlotRange -> 5]

enter image description here

  • Test the projection between two arbitrary planes.
Clear["Global`*"];
SeedRandom[11111];
{u1, u2} = Orthogonalize@RandomPoint[Sphere[], 2];
pt1 = RandomReal[{-5, 5}, 3];
plane1 = InfinitePlane[pt1, {u1, u2}];
c1[t_] := pt1 + {Cos[t], Sin[t]} . {u1, u2};
{v1, v2} = Orthogonalize@RandomPoint[Sphere[], 2];
pt2 = RandomReal[{-5, 5}, 3];
plane2 = InfinitePlane[pt2, {v1, v2}];
dir = RandomPoint[Sphere[]];
sol = Solve[c1[t] + s*dir ∈ plane2, s, Reals][[1]];
c2[t_] := c1[t] + s*dir /. sol[[1]];
{{p1, p2, p3, p4}, {q1, q2, q3, q4}} = 
  Transpose@
   Table[{c1[t], c2[t]}, {t, 
     1 + {0, π/2, 2 π/2, 3 π/2}}];
Show[Graphics3D[{FaceForm[], plane1, plane2}], 
 ParametricPlot3D[c1[t], {t, 0, 2 π}], 
 ParametricPlot3D[c2[t], {t, 0, 2 π}], 
 Graphics3D[{Arrowheads[.025], AbsoluteThickness[2], Blue, 
   Line[{{p1, p3}, {p2, p4}}], Line[{{q1, q3}, {q2, q4}}], Orange, 
   Arrow /@ {{p1, q1}, {p2, q2}, {p3, q3}, {p4, q4}}}], 
 PlotRange -> All, Boxed -> False]

enter image description here

$\endgroup$
9
$\begingroup$

Perhaps a litle bit more direct approach than @cvgmt' answer

e1 = {1, 0, 0};
e2 = {0, 1, 0};
e3 = {0, 0, 1};
c1[t_] := 2 e3 + {Cos[t], Sin[t]} . {e2, e3};

projection

p = e3 - e1; (* direction of projection*)
n = e3;      (* normal of projection plane*)   
e = 0 e3 ;   (* point of projection plane*)
proj[x_List] := x -  n . (x - e)/n . p p

Show[{
ParametricPlot3D[ {c1[t] , proj[c1[t]]}, {t, 0, 2 Pi}  ], 
Graphics3D[{Table[Arrow[{c1[t], proj[c1[t]]}], {t, {0, Pi/2, Pi, 3Pi/2}}]}]
}, Boxed -> False, Axes -> False]

enter image description here

$\endgroup$
1
  • $\begingroup$ Funny how the default colors seem to produce a Portal. $\endgroup$ Nov 9, 2023 at 12:33

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.