1
$\begingroup$

I have a 3D surface (specifically a sphere, if that makes things easier) and I am plotting the contours of a function over this surface using MeshFunction. I also want to highlight some key points on this function using ListPointPlot3D.

This works OK, but I would like to change the point markers to different shapes (the graphic should work when printed monochrome) and have the markers lying flat on the surface itself. I tried the BubbleChart3D solution in Use a custom 3D graphic for points in ListPointPlot3D but using 3D graphics sticking out of the sphere looks very strange, and the aspect ratio is also always slightly off.

Is there maybe some way of projecting shapes/text onto a curved surface, or, for a sphere-specific option, using something similar to Triangle mapped on a sphere in $\mathbb R^3$?? Or perhaps something using Textures?


Edit: I don't currently have any solution to this problem. An example of an attempt at plotting distinct markers over a sphere is shown below, but the first case does not work in black-and-white, and the second does not have shapes lying flat on the surface (as well as the markers being distorted unless individually tuned to avoid this). What I'm looking for is code which draws the markers as if "painted onto" the surface. If it could work for general surfaces, that would be excellent, but just a sphere is enough for now.

randomPointsOnSphere = 
  n |-> {Sin[#1] Cos[2 #2], Sin[#1] Sin[2 #2], Cos[#1]} & @@@ 
    RandomReal[\[Pi], {n, 2}];
highlightPointsA = randomPointsOnSphere[4]
highlightPointsB = randomPointsOnSphere[4]
highlightPointsC = randomPointsOnSphere[4]
sphericalPlot = 
  ParametricPlot3D[{Sin[\[Theta]] Cos[\[Phi]], 
    Sin[\[Phi]] Sin[\[Theta]], Cos[\[Theta]]}, {\[Theta], 
    0, \[Pi]}, {\[Phi], 0, 2 \[Pi]}, PlotStyle -> Opacity[0.5], 
   Mesh -> None];

(* 1st attempt *)
Show[sphericalPlot, 
 ListPointPlot3D[{highlightPointsA, highlightPointsB, 
   highlightPointsC}], PlotStyle -> PointSize[0.1]]

(* 2nd attempt *)
Show[sphericalPlot,
 MapThread[
  BubbleChart3D[Append[#, 1] & /@ #1, BubbleSizes -> {.05, .05},
    ChartElements -> Graphics3D[#2], ChartStyle -> Black, 
    FaceGrids -> None] &, {
   {highlightPointsA, highlightPointsB, highlightPointsC},
   {PolyhedronData["Tetrahedron", "Faces"], Cuboid[], Sphere[]}
   }]]
$\endgroup$
0

0

Your Answer

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

Browse other questions tagged or ask your own question.