0
$\begingroup$

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:

enter image description here

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

enter image description here

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:

enter image description here

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.)

$\endgroup$
  • $\begingroup$ Use Sphere instead of Point? $\endgroup$ – Henrik Schumacher May 25 '18 at 13:59
  • $\begingroup$ Possibly useful? Multiple plots in SphericalPlot3D. $\endgroup$ – AccidentalFourierTransform May 25 '18 at 14:02
  • $\begingroup$ 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. $\endgroup$ – Spencer Rugaber May 29 '18 at 14:42
3
$\begingroup$

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]}]

enter image description here

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 π}
]

enter image description here

$\endgroup$
3
$\begingroup$

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]

enter image description here

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:

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.