好玩的数学：干点地理老师做的事，让地球仪转起来

点“考研竞赛数学”↑可每天“涨姿势”哦！

旋转效果演示：视频大小1.11M

https://v.qq.com/txp/iframe/player.html?vid=l1332kvafvt&width=500&height=375&auto=0

完整的Mathematica表达式内容如下：

(*从保存Mathematica源文件的文件夹中的地图文件夹下导入地图图片*)

img=Import[NotebookDirectory[]<>"地图\\"<>"map01.png"];

(*r支撑圆环管半径，d圆环管到中心的距离*)

r=0.05;d=1.1;

(*设置图形旋转变换函数，绕y轴旋转30度*)

Rot=RotationTransform[-Pi/6,{0,1,0}];

Manipulate[

Show[

(*绘制地球，材质设置为地图图片，zd设置动画旋转效果*)

ParametricPlot3D[Rot[{Cos[u]Sin[v],Sin[u]Sin[v],Cos[v]}],{u,0+zd,2\[Pi]+zd},{v,0,\[Pi]},Mesh->None,PlotStyle->Texture[img],TextureCoordinateFunction->({#4,1-#5}&),Lighting->"Neutral",PlotPoints->50,RotationAction->"Clip"],

(*绘制圆管支撑*)

ParametricPlot3D[Rot[{(d+r Cos[u])Cos[t],r Sin[u] ,(d+r Cos[u])Sin[t]}],{t,Pi/2-Pi/24,3Pi/2+Pi/24},{u,0,2Pi},Mesh->None,Lighting->{{"Point",White,Scaled[{2,-1,1}]}},PlotStyle->Orange,PlotPoints->50],Graphics3D[{EdgeForm[None],Lighting->{{"Point",White,Scaled[{2,-1,1}]}},Orange,

(*贯穿球的圆管子*)

Tube[{Rot[{0,0,-1.1}],Rot[{0,0,1.1}]},0.02],

(*绘制底座，球和锥*)

{Sphere[{0,0,-1.2},0.08],Cone[{{0,0,-1.8},{0,0,-1.2}},1/2]}}],Axes->False,Boxed->False,PlotRange->All,ViewPoint->Front],

(*设置滑动条标签和旋转参数*)

{{zd,0,"考研竞赛数学(ID:xwmath)"},0,2Pi}]

【注1】如果要输出为视频或者GIF动画，则将Manipulate更改为Table，然后将最后一行{{zd,0,"考研竞赛数学(ID:xwmath)"},0,2Pi}]更改为{zd, 0, 2 Pi, 0.02}];，并添加一行：

Export["earth.gif",%]

表示将旋转一圈的地球仪输出为gif动画，更改后缀名为avi,swf等，则输出为视频文件。

【注2】以上表达式不是最优的，只是保证效果能够实现！直接复制粘贴上面的源代码到Mathematica软件可以直接执行获得交互式执行结果。值得注意的是：要先保存为Mathematica文件，然后在同一文件夹下创建一个子文件夹，名称为“地图”，并在下面保存map01.png的地图贴图图像文件，当然也可以将表达式的文件名改成其他名称的地图文件，以上贴图来自百度搜索，图片如下：

相关推荐

数学软件Mathematica使用教学视频：好玩的数学：用Mathematica学数学和做数学请点击本文左下角“阅读原文”进入在线课堂！

微信公众号：考研竞赛数学(ID: xwmath) 大学数学公共基础课程分享交流平台！

↓↓↓点阅读原文查看所有文章列表