研一的时候闲着无聊就一直想做3D模型,由于自己本身是做地学的,想画一个地球仪也是理所当然,于是就有了stackoverflow上各种问道,问题被close,表述不清,经历很多风雨只有,在一位外国有人的热心提示下做出了自己想要的东西,时隔两年,今天把当年的努力过程整理一下,算是献给简书的第一篇文章。
(*elev data input*)
elev1d = BinaryReadList[ "D:\\topo\\ETOPO5.DAT", {"Integer16"}, ByteOrdering -> +1];
elev2d = ArrayReshape[elev1d, {2160, 4320}];
lati = Flatten@Transpose@Table[Rest@Table[i, {i, 90, -90, -1/12}], {4320}];
long = Flatten@Table[Rest@Table[i, {i, 0, 360, 1/12}], {2160}];
(*make a {lat,lon,altitude} matrix*)
elevlatlon = Transpose@{lati, long, Flatten@elev1d};
(*select part of the huge amount of data,add mean earth radius to altitude*)
elevlatlonInUse = (elevlatlon[[;; ;; 12, All]] /. {m_, n_, o_} -> {m, n, o/200 + 6721}) /. {x_, y /; y > 180, z_} -> {x, y - 360, z};
coordsToXYZ[list_] := Transpose[{Cos[#[[1]]*Pi/180.]*Cos[#[[2]]*Pi/180.]*#[[3]], Cos[#[[1]]*Pi/180.]*Sin[#[[2]]*Pi/180.]*#[[3]], Sin[#[[1]]*Pi/180.]*#[[3]]} &@Transpose[list]]
xyz = First[coordsToXYZ /@ {elevlatlonInUse}];
ListPointPlot3D[xyz, BoxRatios -> {1, 1, 1}]
ListSurfacePlot3D[xyz, BoxRatios -> {1, 1, 1}]
结果显示并不是我想要的,因为mma无法差值到一个3D的球面,最后可能出于方差最小之类的考虑,给我了这样一个乱七八糟的平面:事实上,画出点的分布,发现也是没错的:
所以,ListSurfacePlot3D被证明不适合画这样大数据量的差值表面,只能用球坐标函数搞定了:
elev1d = BinaryReadList["D:\\topo\\ETOPO5.DAT", {"Integer16"}, ByteOrdering -> +1];
elev2d = ArrayReshape[elev1d, {2160, 4320}]/5 + 6731;
elevplot2d = ListContourPlot[elev2d[[2160 ;; 1 ;; -6, 1 ;; 4320 ;; 6]], ContourStyle -> None, ColorFunction -> "Topographic", Frame -> None, AspectRatio -> 0.5, ImageSize -> Full, PlotRangePadding -> None];
sealevel3d = ParametricPlot3D[ {6731*Cos[lon]*Sin[lat], 6731*Sin[lon]*Sin[lat], 6731*Cos[lat]}, {lon, 0, 2 Pi}, {lat, -Pi, 0}, Lighting -> "Neutral", RotationAction -> "Clip", Mesh -> None, Axes -> False, Boxed -> False, PlotStyle -> Directive[Opacity[0.5], Blue] ];
terr3d = ParametricPlot3D[ {elev2d[[Round@(lat/Pi*180*12), Round@(lon/Pi*180*12)]]*Cos[lon]* Sin[lat], elev2d[[Round@(lat/Pi*180*12), Round@(lon/Pi*180*12)]]*Sin[lon]* Sin[lat], elev2d[[Round@(lat/Pi*180*12), Round@(lon/Pi*180*12)]]*Cos[lat]}, {lon, 0, 2 Pi}, {lat, -Pi, 0}, TextureCoordinateFunction -> ({1-#4, 1 - #5} &), PlotStyle -> Texture[Show[elevplot2d, ImageSize -> 1000]], Lighting -> "Neutral", RotationAction -> "Clip", Mesh -> None, Axes -> False, PlotPoints -> 35, Boxed -> False ];
Show[sealevel3d, terr3d]
成品是这样的(配色依然有点丑,别介意诸位):当然,不画球状的3D地形还是很简单的:
elev1d = BinaryReadList["D:\\project\\mma\\topo\\ETOPO5.DAT", {"Integer16"},ByteOrdering -> +1];
lati = Flatten@Transpose@Table[Rest@Table[i, {i, 90, -90, -1/12}], {4320}];
long = Flatten@Table[Rest@Table[i, {i, 0, 360, 1/12}], {2160}];
elevlatlon = Transpose@{long, lati, Flatten@elev1d} /. {x_ /; x > 180, y_, z_} -> {x - 360, y, z};
elevplot3d =
ListPlot3D[
Cases[elevlatlon[[;; ;; 6, All]], {x_ /; x > 70 && x < 105,
y_ /; y > 25 && y < 45, _}], Mesh -> None,
ColorFunction -> "Topographic", MeshFunctions -> {#3 &},
BoxRatios -> {2, 1, 0.1}, ImageSize -> Full]
最后贴上地形数据源:ETOPO5.dat