3

I have a cone:

wk = 1 + v Norm[{qx, qy}];
Omega = 0.01;
v = (3/2) Omega;
cone = Plot3D[wk, {qx, -Pi/2, Pi/2}, {qy, -Pi/2, Pi/2}, 
  MeshStyle -> None, PlotRange -> {1, 1.02}, ClippingStyle -> None, 
  ColorFunction -> "ThermometerColors", BoxStyle -> Opacity[0], 
  Axes -> None]

To this cone I would like to add 3D arrows. The tails will start exactly at the surface and point out in a direction outward from the cone but in the x-y plane. As a visual reference I would like to reproduce (to some extent) the figure below but with the arrows exactly at the top, exactly at the very bottom and at intermediate stages up the cone (also I am not interested in the blue arrows shown below).

enter image description here

I have tried modifying the answer from this question, but as I'm very unfamiliar with this sort of plot I am quite lost.

Lastly just to note I will be extending a solution to be able to produce arrows on the surface that have 3D directions that are not just in the x-y plane and have a more complicated dependence on the {x,y} value.

Community
  • 1
Tom
  • 3,416
  • 1
  • 18
  • 33

2 Answers2

5

Edit

arrows[p_, d_, t_] := Arrow@Table[
   RotationTransform[\[Pi]/6 i , {0, 0, 1}]@
    RotationTransform[t  , {0, 0, 1} , {p *((d + 1)/2), 0, 1}]@
     {{p, 0, 1.02}, {p *d, 0, 1.02}}, {i, 24}]

arrg = Graphics3D[{Arrowheads[Small],
    Blue, arrows[1.13, 1.4, \[Pi]/2],
    Green, arrows[1.5, 0.7, \[Pi]/2],
    Red, arrows[1.35, 1.2, 0]},
   PlotRange -> {{-2, 2}, {-2, 2}, {1, 1.02}},
   ImageSize -> 300];

Show[cone, arrg, BoxRatios -> {1, 1, 2/3}]

Blockquote

Origin

r = RotationTransform[\[Pi]/12, {0, 0, 1}];
arrows[p_, d_] := 
  Graphics3D[{Darker@Blue, Arrowheads[Small], 
    Arrow@NestList[r, {{p, 0, 1.02}, {p *d, 0, 1.02}}, 24]},
   PlotRange -> {{-2, 2}, {-2, 2}, {1, 1.02}}, ImageSize -> 300];

Show[cone, arrows[1.35, #],
   BoxRatios -> {1, 1, 2/3}, Boxed -> False] & /@ {0.7, 1.2}

Blockquote

Junho Lee
  • 5,155
  • 1
  • 15
  • 33
0

Thanks to Kuba's simple suggestion I present a possible solution to my own question:

1) Create the cone in a simple way using Plot3D
2) 'createArrow' creates a single arrow from two points (tail and tip)
3) 'createCircle' takes an input which corresponds to how far up the z-axis we want to consider and churns out a list of pairs of tail and tip points located around the cone, with orientations dependent on location on cone. It equally distributes them around the cone.

Below is the code and a resulting plot. Note my answer doesn't directly address the initial question, but it is what I myself ultimately wanted!

w = 100 + Sqrt[v^2 Norm[{qx, qy}]^2 + (50 gap)^2];
minEnergy = 100 + 50 gap;
v = (3/2);
gap = 0.002;
zoom = 0.5;
cone = Plot3D[w, {qx, -zoom, zoom}, {qy, -zoom, zoom}, 
   PlotRange -> {100.1, 100.3}, ClippingStyle -> None, Mesh -> None, 
   BoxStyle -> Opacity[0], PlotPoints -> {100, {0, 0}}, 
   MaxRecursion -> 10, Axes -> None, PlotStyle -> {Opacity[0.4], Red}];
phiList = Range[0, 2 Pi, Pi];
createArrow[{pt1_, pt2_}] := Arrow[Tube[{pt1, pt2}, Scaled[0.0007]]]
createCircle[energy_] := (
  qMod = (2/3) Sqrt[(energy - 100)^2 - (50 gap)^2];
  norm = 0.03/(energy - 100);
  {{ qMod Cos[#], qMod  Sin[#], 
      energy}, { qMod Cos[#], qMod Sin[#], energy} + 
      norm {- v qMod Cos[#], -v qMod Sin[#], 50 gap}} & /@ phiList
  )
energies = Range[minEnergy + 0.00000001, 100.3, 0.01];
arrow = Map[createArrow, Flatten[createCircle /@ energies, 1]];
arrows = Graphics3D[{Arrowheads[0.01], Green, arrow}, 
   PlotRange -> {100.1, 100.3}];
Show[cone, arrows]

Tom
  • 3,416
  • 1
  • 18
  • 33