Страница 1 из 1
Выдернуть координаты точек
Добавлено: 03 фев 2015, 13:34
agrozema
Добрый день! Есть шейп в нем участок большой, необходимо получить координаты всех точек из которых состоит этот полигон. Как можно сдеать это?
Re: Выдернуть координаты точек
Добавлено: 03 фев 2015, 13:55
giser
Инструмент "Вершины объекта в точки", потом "Добавить XY".
Re: Выдернуть координаты точек
Добавлено: 03 фев 2015, 14:00
agrozema
Спасибо!
Re: Выдернуть координаты точек
Добавлено: 04 фев 2015, 09:04
Игнатенко Роман
макрос
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