Conic Projection

Author

Eric W. Weisstein
February 15, 2004

This notebook downloaded from http://mathworld.wolfram.com/notebooks/MapProjections/ConicProjection.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/ConicProjection.html.

©2005 Wolfram Research, Inc. except for portions noted otherwise

Plots

coneLines[n_Integer /; n>=3,r_:1,h_:1,z_:0,segs_:1]:=Module[{i,nn=30},
{Table[Line[{{r Cos[2Pi i/n],r Sin[2Pi i/n],z},{0,0,z+h}}],{i,n}],
		Table[Line[Table[{r (segs-j)/segs Cos[2Pi i/nn],r (segs-j)/segs Sin[2Pi i/nn],z+h j/segs},{i,0,nn}]],{j,0,segs-1}]}
]

h=2;
r=1.5;
lon=20Degree;
lat=40Degree;
m=map["earth.pts"];
dz=1;

Show[GraphicsArray[{
Show[Graphics3D[{
	GlobePlot[m,sphere],
	GrayLevel[.6],
	Sphere[1,15,15] /. Polygon->closedline,
	coneLines[15,((h^2-1)/h+dz)/Sqrt[h^2-1],h-1/h+dz,1/h-dz,8],
	EdgeForm[],GrayLevel[1],Sphere[.98,15,15]
	}],
	Boxed->False,DisplayFunction->Identity,
	ViewPoint->1.5sphere[{lat,lon}],Lighting->False,
	PlotRange->{{-r,r},{-r,r},{h,-.5}}],
Show[Graphics3D[{
	GlobePlot[m,sphere],
	{RGBColor[1,0,0],GlobePlot[m,cone[h]]},
	GrayLevel[.6],
	Sphere[1,15,15] /. Polygon->closedline,
	coneLines[15,((h^2-1)/h+dz)/Sqrt[h^2-1],h-1/h+dz,1/h-dz,8],
	EdgeForm[],GrayLevel[1],Sphere[.98,15,15]
	}],
	Boxed->False,DisplayFunction->Identity,
	ViewPoint->1.5sphere[{lat,lon}],Lighting->False,
	PlotRange->{{-r,r},{-r,r},{h,-.5}}],
Show[Graphics3D[{
	{RGBColor[1,0,0],GlobePlot[m,cone[h]]},
	GrayLevel[.6],
	coneLines[15,((h^2-1)/h+dz)/Sqrt[h^2-1],h-1/h+dz,1/h-dz,8]
	}],
	Boxed->False,DisplayFunction->Identity,
	ViewPoint->1.5sphere[{lat,lon}],Lighting->False,
	PlotRange->{{-r,r},{-r,r},{h,-.5}}]
}]]

h=2;
dz=1;
Show[GraphicsArray[{
Show[Graphics3D[{
	{RGBColor[1,0,0],GlobePlot[m,cone[h]]},
	GrayLevel[.6],
	coneLines[24,((h^2-1)/h+dz)/Sqrt[h^2-1],h-1/h+dz,1/h-dz,8],
	{Thickness[.01],GrayLevel[0],Line[{{0,0,1.2},{-1.2,0,1.2}}]}
	}],
	Boxed->False,DisplayFunction->Identity,
	ViewPoint->{0,0,2},Lighting->False,
	ViewVertical->{-1,0,0},
	PlotRange->{{-1.5,1.5},{-1.5,1.5},{h,-1}}
],
Show[Graphics[{
	{GrayLevel[.6],GlobePlot[grids,conic[h]]},
	GlobePlot[map["earth.pts"],conic[h],splitline]
	}],
	AspectRatio->Automatic,DisplayFunction->Identity,
	PlotRange->{{-1.5,1.5},{-1.5,.5}}
]
}]]