Can a ListPointPlot3D be overlayed with map

Question

I am trying to make a graph of earthquakes (position and depth) shown on map of the country. The map is drawn with Graphics3D option with the code:

Graphics3D[{Opacity[1.5], 
  Map[Append[Reverse[#], 0] &, 
   EntityValue[Entity["Country", "Macedonia"], "Polygon"] /. 
    GeoPosition -> Identity, {-2}], Blue, Opacity[2]}, Axes -> True]

and using a txt file with the coordinates for position and depth of the events an ListPointPlot3D was made.

I have problem to overlay the graphs to get a picture similar to this one.

Can I get help with this? Thanks in advance.

Answer 1

Compare the data from EarthquakeData to your events list. The difference is that EarthquakeData uses GeoPosition for latitude and longitude, but your events are a simple list of latitude, longitude and depth. It's easy to convert the list to use GeoPosition. Then you can use the Visualize Depth and Position of Earthquakes demonstration code with your list of events.

I need some sample data. Convert data to use GeoPosition, then simply change data to dataGeoPosition in the demonstration code.

data = {{41.87, 22.09, 18.}, {41.96, 21.55, 5.}, {41.129, 20.987, 10.},
 {41.13, 20.83, 4.}, {41.2, 20.72, 15.}, {41.302, 20.864, 10.}, 
 {41.183, 21.196, 14.}, {41.158, 22.567, 10.}, {41.279, 20.884, 39.},
 {42.052, 21.257, 13.}};

dataGeoPosition = {GeoPosition@#[[;; 2]], Last[#]} & /@ data;

Graphics3D[{Opacity[0.6],
  Map[Append[Reverse[#], 0] &,
    EntityValue[Entity["Country", "Macedonia"], "Polygon"] /.
    GeoPosition -> Identity, {-2}],
  Blue, Opacity[1],
  Line[Apply[{Append[Reverse[First[#]], 0],
      Append[Reverse[First[#]], -#2]} &,
    dataGeoPosition, {1}]]},
  Axes -> True, BoxRatios -> {1, 1, 1/2}]

We can use your events list without GeoPosition if we modify the demonstration code, and we get the same result.

Graphics3D[{Opacity[0.6],
    Map[Append[Reverse[#], 0] &,
      EntityValue[
          Entity["Country", "Macedonia"],
           "Polygon"] /. GeoPosition -> Identity, {-2}],
    Blue, Opacity[1],
    Line[{Append[Reverse[#[[;; 2]]], 0],
      Append[Reverse[#[[;; 2]]], -Last[#]]} & /@ data]},
  Axes -> True, BoxRatios -> {1, 1, 1/2}]

Here's how you can use your original method that combines Graphics3D and ListPointPlot3D. Notice that all of these methods reverse latitude and longitude to preserve the correct orientation for Graphics3D.

a = Graphics3D[{Opacity[0.6],
      Map[Append[Reverse[#], 0] &,
        EntityValue[
            Entity["Country", "Macedonia"], "Polygon"] /.
      GeoPosition -> Identity, {-2}]}, Axes -> True];
b = ListPointPlot3D[
  Append[Reverse[#[[;; 2]]], Last[#]] & /@ data,
  PlotRange -> All, Filling -> Bottom, FillingStyle -> Thin];
Show[a, b, BoxRatios -> {1, 1, 1/2}]