从R中的Excel数据创建地图多边形
我有一个lat-long坐标列表,每个坐标都有相应的方位角(方向),例如: 对于每个独特的单元,我想创建一个三角形多边形,该多边形朝向相应单元的方位角方向,宽度为65度,半径为2km。我想生成类似于下面所示的形状 有谁能告诉我,我如何开始编码,循环遍历文件中的每个条目,以及如何生成一个包含每个条目的多边形的google earth文件?大约有9000个单元格需要多边形,但如果我能为一个小样本工作,我将非常高兴从R中的Excel数据创建地图多边形,excel,leaflet,rstudio,google-earth,Excel,Leaflet,Rstudio,Google Earth,我有一个lat-long坐标列表,每个坐标都有相应的方位角(方向),例如: 对于每个独特的单元,我想创建一个三角形多边形,该多边形朝向相应单元的方位角方向,宽度为65度,半径为2km。我想生成类似于下面所示的形状 有谁能告诉我,我如何开始编码,循环遍历文件中的每个条目,以及如何生成一个包含每个条目的多边形的google earth文件?大约有9000个单元格需要多边形,但如果我能为一个小样本工作,我将非常高兴 这是我在论坛上写的一篇关于六边形瓷砖的脚本。有些调用是对GIS API的,但我认为您
这是我在论坛上写的一篇关于六边形瓷砖的脚本。有些调用是对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
这里有一个清理版本,只开发了一个十六进制平铺。你应该能够修改它来做你想做的事
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
你所做的一切听起来真令人印象深刻!你能解释一下你想要的最终结果是什么吗?你还在为此寻找解决方案吗?我理解你的意思,你想得到每个点三个多边形的结果?嗨,我想我用一些基本的三角学计算出来了,这很粗糙,但很有效。由于我有一个场地坐标、波束宽度、到边缘的距离以及我希望计算的点数,geosphere包中的destPoint函数非常有用。它沿着多边形计算端点,然后我可以在传单中映射它们。如果你有更好的选择,我会很高兴听到。不,我也会用三角法解决这个问题…但我不太了解这个问题,所以需要一些时间-我的想法是:创建一个圆(有些我有一个脚本或函数可以做到这一点),然后根据角度将其切成6部分。谢谢你的回复,你能给我一张输出的图片,这样我就可以看到它创造了什么?我要花一点时间来解码剧本。非常感谢。输出只有六个点和一个质心。上面的脚本只打印即时窗口中的点。
Public X As Double
Public Y As Double