Выдернуть координаты точек
- agrozema
- Активный участник
- Сообщения: 152
- Зарегистрирован: 05 мар 2013, 15:36
- Репутация: 85
Выдернуть координаты точек
Добрый день! Есть шейп в нем участок большой, необходимо получить координаты всех точек из которых состоит этот полигон. Как можно сдеать это?
Последний раз редактировалось agrozema 03 фев 2015, 14:00, всего редактировалось 1 раз.
-
- Завсегдатай
- Сообщения: 388
- Зарегистрирован: 09 ноя 2012, 09:25
- Репутация: 113
- Откуда: Москва
Re: Выдернуть координаты точек
Инструмент "Вершины объекта в точки", потом "Добавить XY".
- agrozema
- Активный участник
- Сообщения: 152
- Зарегистрирован: 05 мар 2013, 15:36
- Репутация: 85
Re: Выдернуть координаты точек
Спасибо!
-
- Интересующийся
- Сообщения: 35
- Зарегистрирован: 02 июл 2014, 10:55
- Репутация: 0
- Откуда: г. Сальск
- Контактная информация:
Re: Выдернуть координаты точек
макрос
Sub Print_Vedomost()
' печать ведомости координат
Dim pMXD As IMxDocument
Dim i As Long, Angle As Double, Lz As Double, dTotalArea As Double, dPerimeter As Double
Dim pFeat As IFeature, pGeom As IGeometry, pp As IPoint, pArea As IArea
Dim pSelected As IEnumFeature
Dim Name As String
Close #1
Name = "C:\Ведомость координат.txt"
Open Name For Output As #1
Print #1, " "
Print #1, " Ведомость координат объекта"
Print #1, "|-----------------------------------------------------------------------|"
Print #1, "| № | Координата | Координата | Дирекционный | Расстояние |"
Print #1, "|точки | X | Y | угол | |"
Print #1, "|-----------------------------------------------------------------------|"
Set pMXD = ThisDocument
If pMXD.FocusMap.SelectionCount <> 1 Then
MsgBox "Вы не выбрали объекта в текущем слое"
Exit Sub
End If
Set pSelected = pMXD.FocusMap.FeatureSelection
pSelected.Reset
Set pFeat = pSelected.Next
Set pArea = pFeat.Shape
dTotalArea = pArea.Area
dPerimeter = 0
Dim Map As IMap, Line As ILine
Dim p1 As IPoint, p2 As IPoint, PC As IPointCollection
Set Map = pMXD.FocusMap
Map.DistanceUnits = esriMeters
Set PC = pFeat.ShapeCopy
For i = 0 To PC.PointCount - 1
Set pGeom = PC.Point(i)
Set pp = pGeom
Set p2 = pGeom
Set Line = New Line
If i > 0 Then
Lz = Map.ComputeDistance(p1, p2)
Line.PutCoords p1, p2
Angle = Line.Angle * 180 / (4 * Atn(1))
Angle = 90 - Angle
If Angle < 0 Then Angle = 270 - Angle
End If
dPerimeter = dPerimeter + Lz
Set p1 = pGeom
' номер точки, дирекционный угол, расстояние до предыдущ. точки, х,у
'Debug.Print i, Angle, Lz, pp.X, pp.Y
Print #1, "|----------------------------------------", FormatNumber(Angle, 2), FormatNumber(Lz, 2)
Print #1, i, FormatNumber(pp.Y, 3), FormatNumber(pp.X, 3), "------------------------------|"
Next
Print #1, "|-----------------------------------------------------------------------|"
Print #1, " Площадь объекта =", FormatNumber(dTotalArea, 2), "кв.м"
Print #1, " Периметр объекта =", FormatNumber(dPerimeter, 2), "м"
Close #1
'MsgBox "Файл " & Name & " сохранён на диск ", vbInformation
MsgBox "Файл " & Name & " сохранён на диск С"
MsgBox "Чтоб ты жил на одну зарплату!!!"
End Sub
Sub Print_Vedomost()
' печать ведомости координат
Dim pMXD As IMxDocument
Dim i As Long, Angle As Double, Lz As Double, dTotalArea As Double, dPerimeter As Double
Dim pFeat As IFeature, pGeom As IGeometry, pp As IPoint, pArea As IArea
Dim pSelected As IEnumFeature
Dim Name As String
Close #1
Name = "C:\Ведомость координат.txt"
Open Name For Output As #1
Print #1, " "
Print #1, " Ведомость координат объекта"
Print #1, "|-----------------------------------------------------------------------|"
Print #1, "| № | Координата | Координата | Дирекционный | Расстояние |"
Print #1, "|точки | X | Y | угол | |"
Print #1, "|-----------------------------------------------------------------------|"
Set pMXD = ThisDocument
If pMXD.FocusMap.SelectionCount <> 1 Then
MsgBox "Вы не выбрали объекта в текущем слое"
Exit Sub
End If
Set pSelected = pMXD.FocusMap.FeatureSelection
pSelected.Reset
Set pFeat = pSelected.Next
Set pArea = pFeat.Shape
dTotalArea = pArea.Area
dPerimeter = 0
Dim Map As IMap, Line As ILine
Dim p1 As IPoint, p2 As IPoint, PC As IPointCollection
Set Map = pMXD.FocusMap
Map.DistanceUnits = esriMeters
Set PC = pFeat.ShapeCopy
For i = 0 To PC.PointCount - 1
Set pGeom = PC.Point(i)
Set pp = pGeom
Set p2 = pGeom
Set Line = New Line
If i > 0 Then
Lz = Map.ComputeDistance(p1, p2)
Line.PutCoords p1, p2
Angle = Line.Angle * 180 / (4 * Atn(1))
Angle = 90 - Angle
If Angle < 0 Then Angle = 270 - Angle
End If
dPerimeter = dPerimeter + Lz
Set p1 = pGeom
' номер точки, дирекционный угол, расстояние до предыдущ. точки, х,у
'Debug.Print i, Angle, Lz, pp.X, pp.Y
Print #1, "|----------------------------------------", FormatNumber(Angle, 2), FormatNumber(Lz, 2)
Print #1, i, FormatNumber(pp.Y, 3), FormatNumber(pp.X, 3), "------------------------------|"
Next
Print #1, "|-----------------------------------------------------------------------|"
Print #1, " Площадь объекта =", FormatNumber(dTotalArea, 2), "кв.м"
Print #1, " Периметр объекта =", FormatNumber(dPerimeter, 2), "м"
Close #1
'MsgBox "Файл " & Name & " сохранён на диск ", vbInformation
MsgBox "Файл " & Name & " сохранён на диск С"
MsgBox "Чтоб ты жил на одну зарплату!!!"
End Sub
Кто сейчас на конференции
Сейчас этот форум просматривают: нет зарегистрированных пользователей и 2 гостя