3D projection on xy and xz planes

Questions
,
1

I have this equation in spherical coordinates and I want to make contour on xy, xz planes

t[[Theta], [Phi]] := 1/(0.0041542 - (2 (0.0041542 + 0.0011726) - 0.0079190) ([Alpha]^2 [Beta]^2 + [Alpha]^2 [Gamma]^2 + \ [Beta]^2 [Gamma]^2));

[Alpha] = Sin[[Theta]] Cos[[Phi]]; [Beta] = Sin[[Theta]] Sin[[Phi]]; [Gamma] = Cos[[Theta]];

SphericalPlot3D[ t[[Theta], [Phi]], {[Theta], 0, Pi}, {[Phi], 0, 2 Pi}, Axes -> True, Ticks -> {{-200, -100, 0, 100, 200}, {-200, -100, 0, 100, 200}, {-200, -100, 0, 100, 200}}, LabelStyle -> {FontSize -> 12, FontFamily -> "Times", Black}, ImageSize -> {350, 350}, FaceGridsStyle -> Directive[Black, Dashed], ImagePadding -> 50, LabelStyle -> Directive[Bold, Black]]

jjj.png
jjj.png350×350 38.1 KB

2

Do you mean you want to project the contours onto the planes? Here is a way:

\[Alpha] = Sin[\[Theta]] Cos[\[Phi]]; \[Beta] = 
 Sin[\[Theta]] Sin[\[Phi]]; \[Gamma] = Cos[\[Theta]];
t[\[Theta]_, \[Phi]_] := 
  1/(0.0041542 - (2 (0.0041542 + 0.0011726) - 
        0.0079190) (\[Alpha]^2 \[Beta]^2 + \[Alpha]^2 \[Gamma]^2 +  \
\[Beta]^2 \[Gamma]^2));
wireframe = 
 SphericalPlot3D[
  t[\[Theta], \[Phi]], {\[Theta], 0, Pi}, {\[Phi], 0, 2 Pi}, 
  Axes -> True, 
  Ticks -> {{-200, -100, 0, 100, 200}, {-200, -100, 0, 100, 
     200}, {-200, -100, 0, 100, 200}}, 
  LabelStyle -> {FontSize -> 12, FontFamily -> "Times", Black}, 
  ImageSize -> {350, 350}, FaceGridsStyle -> Directive[Black, Dashed],
   ImagePadding -> 50, LabelStyle -> Directive[Bold, Black], 
  PlotStyle -> None]
Graphics3D[
 Normal[wireframe[[1]]] /. 
  Line[lst_] :> 
   Line[Map[Function[xyz, {xyz[[1]], xyz[[2]], 0}], lst]]]
3

Thank you very much Dr. Gianluca Gorni
I want to keep only the projections as in the figure below.

projection.png
projection.png266×260 60 KB

4

You should clarify what you mean by “contour”.

5

In those pictures I can’t see “contours”, but rather arrangements of dots.

Maybe this is more similar to what you are seeking:

\[Alpha] = Sin[\[Theta]] Cos[\[Phi]]; \[Beta] = 
 Sin[\[Theta]] Sin[\[Phi]]; \[Gamma] = Cos[\[Theta]];
t[\[Theta]_, \[Phi]_] := 
  1/(0.0041542 - (2 (0.0041542 + 0.0011726) - 
        0.0079190) (\[Alpha]^2 \[Beta]^2 + \[Alpha]^2 \[Gamma]^2 + \
\[Beta]^2 \[Gamma]^2));
wireframe = 
 SphericalPlot3D[
  t[\[Theta], \[Phi]], {\[Theta], 0, Pi}, {\[Phi], 0, 2 Pi}, 
  Axes -> True, 
  Ticks -> {{-200, -100, 0, 100, 200}, {-200, -100, 0, 100, 
     200}, {-200, -100, 0, 100, 200}}, 
  LabelStyle -> {FontSize -> 12, FontFamily -> "Times", Black}, 
  ImageSize -> {350, 350}, FaceGridsStyle -> Directive[Black, Dashed],
   ImagePadding -> 50, LabelStyle -> Directive[Bold, Black], 
  PlotStyle -> None, MeshFunctions -> {#6 &}]
Graphics3D[
 Normal[wireframe[[1]]] /. 
  Line[lst_] :> 
   Line[Map[Function[xyz, {xyz[[1]], xyz[[2]], 0}], lst]]]
6

Thank you for valuable help
How to change the origin of these plots?

\[Alpha] = Sin[\[Theta]] Cos[\[Phi]]; \[Beta] = 
 Sin[\[Theta]] Sin[\[Phi]]; \[Gamma] = Cos[\[Theta]];
t[\[Theta]_, \[Phi]_] := 
  1/(0.0041542 - (2 (0.0041542 + 0.0011726) - 
        0.0079190) (\[Alpha]^2 \[Beta]^2 + \[Alpha]^2 \[Gamma]^2 + \
\[Beta]^2 \[Gamma]^2));
wireframe = 
 SphericalPlot3D[
  t[\[Theta], \[Phi]], {\[Theta], 0, Pi}, {\[Phi], 0, 2 Pi}, 
  Axes -> True, 
  Ticks -> {{-200, -100, 0, 100, 200}, {-200, -100, 0, 100, 
     200}, {-200, -100, 0, 100, 200}}, 
  LabelStyle -> {FontSize -> 12, FontFamily -> "Times", Black}, 
  ImageSize -> {350, 350}, FaceGridsStyle -> Directive[Black, Dashed],
   ImagePadding -> 50, LabelStyle -> Directive[Bold, Black], 
  ColorFunction -> (ColorData["DarkRainbow"][#6] &), PlotStyle -> None]



p1 = Graphics3D[
  Normal[wireframe[[1]]] /. 
   Line[lst_] :> 
    Line[Map[Function[xyz, {xyz[[1]], xyz[[2]], 0}], lst]]]
p2 = Graphics3D[
  Normal[wireframe[[1]]] /. 
   Line[lst_] :> 
    Line[Map[Function[xyz, {xyz[[1]], 0, xyz[[3]]}], lst]]]
p3 = Graphics3D[
  Normal[wireframe[[1]]] /. 
   Line[lst_] :> 
    Line[Map[Function[xyz, {0, xyz[[2]], xyz[[3]]}], lst]]]


Show[p1, p2, p3, PlotRange -> All, BoxRatios -> {1, 1, 1}]

projectt.png
projectt.png370×367 13.5 KB

7

[Alpha] = Sin[[Theta]] Cos[[Phi]]; [Beta] =
Sin[[Theta]] Sin[[Phi]]; [Gamma] = Cos[[Theta]];
t[[Theta], [Phi]] :=
1/(0.0041542 - (2 (0.0041542 + 0.0011726) -
0.0079190) ([Alpha]^2 [Beta]^2 + [Alpha]^2 [Gamma]^2 +
[Beta]^2 [Gamma]^2));
wireframe =
SphericalPlot3D[
t[[Theta], [Phi]], {[Theta], 0, Pi}, {[Phi], 0, 2 Pi},
Axes → True,
Ticks → {{-200, -100, 0, 100, 200}, {-200, -100, 0, 100,
200}, {-200, -100, 0, 100, 200}},
LabelStyle → {FontSize → 12, FontFamily → “Times”, Black},
ImageSize → {350, 350},
FaceGridsStyle → Directive[Black, Dashed], ImagePadding → 50,
LabelStyle → Directive[Bold, Black], PlotStyle → None,
MeshFunctions → {#6 &}];
p1 = Normal[wireframe[[1]]] /.
Line[lst_] :>
Line[Map[Function[xyz, {xyz[[1]], xyz[[2]], -300}], lst]];
p2 = Normal[wireframe[[1]]] /.
Line[lst_] :>
Line[Map[Function[xyz, {xyz[[1]], 300, xyz[[3]]}], lst]]
p3 = Normal[wireframe[[1]]] /.
Line[lst_] :>
Line[Map[Function[xyz, {-300, xyz[[2]], xyz[[3]]}], lst]];
Graphics3D[{p1, p2, p3}]

8

Thank you Gianluca Gorni!
Thank you!
Thank you!

9

Hi,
Is it possible to fill the projected areas with color.

10

Here is a first attempt:

\[Alpha] = Sin[\[Theta]] Cos[\[Phi]]; \[Beta] = 
 Sin[\[Theta]] Sin[\[Phi]]; \[Gamma] = Cos[\[Theta]];
t[\[Theta]_, \[Phi]_] := 
  1/(0.0041542 - (2 (0.0041542 + 0.0011726) - 
        0.0079190) (\[Alpha]^2 \[Beta]^2 + \[Alpha]^2 \[Gamma]^2 + \
\[Beta]^2 \[Gamma]^2));
wireframe = 
  SphericalPlot3D[
   t[\[Theta], \[Phi]], {\[Theta], 0, Pi}, {\[Phi], 0, 2 Pi}, 
   Axes -> True, 
   Ticks -> {{-200, -100, 0, 100, 200}, {-200, -100, 0, 100, 
      200}, {-200, -100, 0, 100, 200}}, 
   LabelStyle -> {FontSize -> 12, FontFamily -> "Times", Black}, 
   ImageSize -> {350, 350}, 
   FaceGridsStyle -> Directive[Black, Dashed], ImagePadding -> 50, 
   LabelStyle -> Directive[Bold, Black], PlotStyle -> None, 
   MeshFunctions -> {#6 &}, PlotPoints -> 50];
p1 = Normal[wireframe[[1]]] /. 
   Line[lst_] :> 
    Line[Map[Function[xyz, {xyz[[1]], xyz[[2]], -300}], lst]];
p2 = Normal[wireframe[[1]]] /. 
  Line[lst_] :> 
   Line[Map[Function[xyz, {xyz[[1]], 300, xyz[[3]]}], lst]]
p3 = Normal[wireframe[[1]]] /. 
   Line[lst_] :> 
    Line[Map[Function[xyz, {-300, xyz[[2]], xyz[[3]]}], lst]];
Graphics3D[{p1, {Green, Cases[p1, Line[pts_] :> Polygon[pts], All]}, 
  p2, p3}]