# How to designate a spot on the surface of a 3D Sphere?

I am trying to designate a small spot on a 3D textured globe. The obvious way is to include a Point in the Graphics3D:

Graphics3D[{
EarthGlobe,
{Red, PointSize[.02], Point[pointOnSurfaceCartesian]},
{Cyan, PointSize[.02], Point[subsolar]}
}, options ...]


[The code for the globe can be found at the Demonstration Site.]

Unfortunately, this approach has aesthetic problems in certain orientations where 1) the spherical Points appear as crescents:

or 2) where the spherical Points bulge outward from the surface:

I suspect that there is an easy and efficient way to do this, but I haven't been able to find it. I have tried the following:

• PerimetricPlot3D with RegionFunction
• PerimetricPlot3D with the parameters in a region
• SphericalPlot3D

The fastest of these is the first, but it requires 300 PlotPoints to look reasonable for ImageSize->Medium, which is still slower than I would like. Moreover, zooming the image leads to an ugly rendering:

Here is the code I ended up using:

Point3D[spot_, color_:Red, size_:.04] :=
First@ParametricPlot3D[
{Sin[t]Cos[p]], Sin[t]]Sin[p], Cos[t]},
{t, 0, Pi},
{p, 0, 2Pi},
RegionFunction->
Function[{x, y, z, u, v},
EuclideanDistance[{x, y, z}, spot] <= size],
PlotStyle->color,
PlotPoints->300,
Mesh->False
];


Can anyone suggest a better way?

(I am running Mathematica 11.0 on a MacBook with OSX 10.9.)

• Use Sphere instead of Point? May 25, 2018 at 13:59
• Possibly useful? Multiple plots in SphericalPlot3D. May 25, 2018 at 14:02
• Thank you for your answers--I learned from both of them. I accepted Carl's because 1) it was a little faster; 2) on my display, the zoom behavior was a little cleaner; and 3) the approach he took was closer to what I was doing in the rest of the application. May 29, 2018 at 14:42

Another possibility is to use a Polygon instead of a point. For example, here is a function that creates a "circular" polygon:

diskPolygon[lat_, long_] := Rotate[
Polygon @ PadRight[CirclePoints[.03, 20], {20, 3}, 1],
{
{0,0,1},
{Cos[long]Sin[lat],Sin[long]Sin[lat],Cos[lat]}
}
]


Simple example:

Graphics3D[{Sphere[], Red, diskPolygon[90 Degree, -45 Degree]}]


We can create a Manipulate allowing you to move the "disk" around the globe (I adopted the globe code from @Michael's answer):

earthmap = Import["https://eoimages.gsfc.nasa.gov/images/imagerecords/57000/57752/land_shallow_topo_2048.tif"];
globe = ParametricPlot3D[
{Sin[θ] Cos[ϕ],Sin[θ] Sin[ϕ],Cos[θ]},
{θ,0,π},
{ϕ,0,2 π},
PlotStyle->Texture[earthmap],
TextureCoordinateFunction->({#5+.5,1-#4}&),
Mesh->True,
SphericalRegion->True
];

Manipulate[
Show[globe, Graphics3D @ {Red,diskPolygon[x,y]}],
{x,0,π},
{y,0,2 π}
]


You could always add the point to the bitmap image directly:

earthmap = Import["https://eoimages.gsfc.nasa.gov/images/imagerecords/57000/57752/land_shallow_topo_2048.tif"]
pointimage[color_, lat_] :=
Rasterize[Graphics[{color, Disk[{0, 0}, 0.01 {1/Cos[lat], 1}]}],
ImageSize -> 0.01 ImageDimensions[earthmap][[1]]/Cos[lat],
Background -> None];
earthmappt[lat_, long_] :=
ImageCompose[earthmap, pointimage[Red, lat],
Scaled[N[{long/(2 \[Pi]) + 1/2, 1/2 + lat/\[Pi]}]]]
globept[lat_, long_] := ParametricPlot3D[
{Sin[\[Theta]] Cos[\[Phi]], Sin[\[Theta]] Sin[\[Phi]],
Cos[\[Theta]]},
{\[Theta], 0, \[Pi]},
{\[Phi], 0, 2 \[Pi]},

PlotStyle -> Texture[earthmappt[lat, long]],
TextureCoordinateFunction -> ({#5 + .5, 1 - #4} &),
Mesh -> True,
SphericalRegion -> True
]

globept[50 Degree, -97 Degree]


Adjust the 0.01 in the expression for the ImageSize option in pointimage to change the size of the point.

This will of course pixelate when zoomed in, but no more than the underlying bitmap texture does: