从R中的Excel数据创build地图多边形
我有一个lat long坐标列表，每个坐标都有对应的方位angular（方向），例如：
Site | Cell | Lat | Long | Azimuth (degrees) | Beamwidth CE0001 | CE0001U09A1 | X | Y | 0 | 65 CE0001 | CE0001U09B1 | X | Y | 120 | 65 CE0001 | CE0001U09C1 | X | Y | 240 | 65 对于每个独特的单元格，我想创build一个三angular形多边形，该单元格的宽度为65deg，半径为2km，对应单元的方位angular方向。 我想生成类似于下面显示的形状。
任何人都可以点我的方向，我可以开始编码，以循环通过我的文件中的每个条目，以及如何生成一个单一的谷歌地球文件包含每个多边形？ 有大约9000个左右的细胞需要一个多边形，但是如果我能把这个工作做一个小样本，我会非常高兴。
这里是和我发布的一个脚本论坛build立六angular形瓷砖的旧post。 一些调用是针对GIS API的，但是我认为你可能会提取所需的VBA代码：
.. VB script to create some hexagon tiles. It creates tiles of a given radius (circle around a tile), not side length. If you want side length you will need to do the math and updte the code. Here is the Comments from the .map file: Creating a drawing of hexagon tiles: R - radius Radius of circumscribed circle around tile a - Apothem: Distance from centroid perpendicular to a side a = R * cos(1/2 * 360/n) (n=6 for a hexagon A set of hexagon tiles would be a series of six sided "circles" centered on two point grids (1 & 2). Both grids would have the spacing of: in X --- 3R in Y --- 2a Grid 2 would be offset from grid 1 by: in X ---- 3R/2 in Y ---- 2a/2 To test script delete all objects in A then run the script. This sample was only tested with a lat/long drawing. I'm not sure of all the ramifications of using a projected drawing. To use with your data set the start point (upper left) in the script and desired radius. Set precision and run Normailize Topology when done to join the tiles. Code was based on the FreeStuff sample scripts ScriptRandomPoints and ScriptSpatialOperations. Please post any problems you find with this code. Hmmm.. the attachments option is gone? :-? Send me your address via email and send the .map file if you'd like. Here's the code: Sub Main ' test lat/long drawing ' ** ** delete all objects in A to test set drawing = Application.ActiveDocument.ComponentSet("A") set objects = drawing.ObjectSet sides = 6 pi = 3.14159 R = 2.5 ' radius in degrees interiorAngle = (360/6) * (pi / 180) ' in radians a = abs(R * cos(0.5 * interiorAngle)) ' apothem ' pick/make a start point - upper left Set startPoint = Application.NewPoint startPoint.X = -25 startPoint.Y = 73.6602540378444 ' grid (4x3x2) for i = 0 to 3 for j = 0 to 2 ' -- create point grid 1 Set point = Application.NewPoint point.X = startPoint.X + (i * 3 * R) point.Y = startPoint.Y - (j * 2 * a) ' objects.Add Application.NewGeom(GeomPoint, point) ' centroid Set pointSet = Application.NewPointSet For k = 0 To sides -1 Set pt = Application.NewPoint ' calculate angle angle = (k*2*Pi/sides)' - (360/sides)/2 ' obtain point on circle pt.X = point.X + R*Cos(angle) pt.Y = point.Y + R*Sin(angle) pointSet.Add(pt) Next objects.Add Application.NewGeom(GeomArea, pointSet) ' -- create point grid 2 Set point = Application.NewPoint point.X = startPoint.X + (i * 3 * R) + ((3 * R)/2) point.Y = startPoint.Y - (j * 2 * a) - a ' objects.Add Application.NewGeom(GeomPoint, point) ' centroid Set pointSet = Application.NewPointSet For k = 0 To sides -1 Set pt = Application.NewPoint ' calculate angle angle = (k*2*Pi/sides)' - (360/sides)/2 ' obtain point on circle pt.X = point.X + R*Cos(angle) pt.Y = point.Y + R*Sin(angle) pointSet.Add(pt) Next objects.Add Application.NewGeom(GeomArea, pointSet) next next msgbox "Done!" End Sub
这是一个清理版本，只是发展一个六angular形瓷砖。 你应该可以修改它来做你想做的事情。
Sub xx() Dim startPoint As clsPoint Dim Point As clsPoint Dim pt As clsPoint Dim pts As Collection Dim s As String ' lat/long (western hemisphere?) Dim sides, i, j, k As Integer Dim Pi, R, interiorAngle, A, Angle As Double sides = 6 Pi = 3.14159 R = 0.25 ' radius in degrees interiorAngle = (360 / 6) * (Pi / 180) ' in radians A = Abs(R * Cos(0.5 * interiorAngle)) ' apothem ' pick/make a start point - upper left Set startPoint = New clsPoint startPoint.X = -121.5 startPoint.Y = 35.5 s = "Longitude" & vbTab & "Latitude" & vbCrLf s = s & startPoint.X & vbTab & startPoint.Y & vbCrLf Set Point = New clsPoint Point.X = startPoint.X '+ (i * 3 * R) Point.Y = startPoint.Y '- (j * 2 * A) Set pts = New Collection For k = 0 To sides - 1 Set pt = New clsPoint ' calculate angle Angle = (k * 2 * Pi / sides) ' - (360/sides)/2 ' Debug.Print Angle ' obtain point on circle pt.X = Point.X + R * Cos(Angle) pt.Y = Point.Y + R * Sin(Angle) pts.Add pt Next For Each pt In pts s = s & pt.X & vbTab & pt.Y & vbCrLf Next Debug.Print s Stop End Sub
clsPoint只包含：
Public X As Double Public Y As Double