Определение координат узлов полилинии

Дата: Понедельник, 11.12.2017, 19:25 | Сообщение № 1

Группа: Пользователи

Ранг: Участник

Сообщений: 66

Репутация: 0 ±

Замечаний: 0% ±

Excel 2013

Здравствуйте, братья по программисткому разуму.
Помогите решить непростую задачу.

На листе находятся несколько Полилиний.
Рядом с ними - табличка.
В ячейку - вписано название полилинии.

Как в таблицу - макросом вписать координаты (X и Y) - узлов указанной в ячейке полилинии ?

К сообщению приложен файл: 235425.xls (37.5 Kb)

Дата: Понедельник, 11.12.2017, 22:28 | Сообщение № 2

Группа: Проверенные

Ранг: Ветеран

Сообщений: 980

Репутация: 127 ±

Замечаний: 0% ±

Excel 2007, Excel 2013

yl3d, попробуйте так:
[vba]

Код

Type point_
    X As Single
    Y As Single
End Type
Sub dsd()
Dim d As Shape
Dim p() As point_
Dim po() As Single
Dim c As Long, r As Long
Set d = ActiveSheet.Shapes(cells(5, 26))

With d.DrawingObject.ShapeRange.Nodes
    ReDim p(.Count)
    For i = 1 To .Count
        po = .Item(i).Points
        p(i).X = po(1, 1)
        p(i).Y = po(1, 2)
    Next i
End With
r = 8
c = 26
For i = 1 To UBound(p)
    cells(i + r, c) = p(i).X
    cells(i + r, c + 1) = p(i).Y
Next i
End Sub

[/vba]

Много чего не знаю!!!!

Дата: Вторник, 12.12.2017, 09:39 | Сообщение № 3

Группа: Пользователи

Ранг: Участник

Сообщений: 66

Репутация: 0 ±

Замечаний: 0% ±

Excel 2013

Roman777, применил ваш макрос.

Получилось странное несовпадение.

В "Полилинии 2" узлов - всего 6.
А макрос выдает координаты для 16 узлов.
То есть - в Полилинии отсутствуют те узлы, для которых макрос выдает координаты.

Как узнать - какие координаты узлов истинные, а какие ложные ?

Дата: Вторник, 12.12.2017, 11:44 | Сообщение № 4

Группа: Проверенные

Ранг: Ветеран

Сообщений: 980

Репутация: 127 ±

Замечаний: 0% ±

Excel 2007, Excel 2013

yl3d, судя по всему, можно попробовать так:
[vba]

Код

Sub dsd()
Dim d
Dim p() As point_
Dim po() As Single
Dim c As Long, r As Long
Set d = ActiveSheet.Shapes(Cells(5, 26))

With d.DrawingObject.ShapeRange.Nodes
    ReDim p(.Count)
    For i = 1 To .Count
        po = .Item(i).Points
        p(i).X = po(1, 1)
        p(i).Y = po(1, 2)
    Next i
End With
r = 8
c = 26
For i = 1 To UBound(p)
    Cells(i + r, c) = p(i).X
    Cells(i + r, c + 1) = p(i).Y
'    Set ff = Worksheets(1).Shapes.AddLine(p(i).X, p(i).Y, p(i).X + 10, p(i).Y + 10)
    If i <> 1 Or i <> UBound(p) Then
        If (i - 1) Mod 3 = 0 Then
            Cells(i + r, c + 2).Interior.Color = 111
'            Set ff = ActiveSheet.Shapes.AddLine(p(i).X, p(i).Y, p(i).X + 10, p(i).Y + 10)
        End If
    End If
Next i
End Sub

[/vba]
По условию выделяю справа ячейку напротив узлов, отображемых при редактировании. Не проверял, но предполагаю, что у каждого узла, отображаемого в режиме редактирования, на самом деле есть "подузел" выше и ниже по линии. Они есть у всех, кроме начального и конечного узла, которые имеют только по одному узлу. Положение этих "подузлов" определяют изгиб кривой.

Много чего не знаю!!!!

Дата: Вторник, 12.12.2017, 12:15 | Сообщение № 5

Группа: Пользователи

Ранг: Участник

Сообщений: 66

Репутация: 0 ±

Замечаний: 0% ±

Excel 2013

Roman777, не работает.
Выдает ошибку :"Compile error: User-defined type not defined"
И выделяет строку : "Dim p() As point_"

Дата: Вторник, 12.12.2017, 12:23 | Сообщение № 6

Группа: Проверенные

Ранг: Ветеран

Сообщений: 980

Репутация: 127 ±

Замечаний: 0% ±

Excel 2007, Excel 2013

yl3d, Перед
[vba]

Код

Sub dsd()

[/vba]
пишем
[vba]

Код

Type point_
X As Single
Y As Single
End Type

[/vba]
как было во втором сообщении №2

Много чего не знаю!!!!

Сообщение отредактировал Roman777 - Вторник, 12.12.2017, 12:24

Дата: Вторник, 12.12.2017, 13:28 | Сообщение № 7

Группа: Пользователи

Ранг: Участник

Сообщений: 66

Репутация: 0 ±

Замечаний: 0% ±

Excel 2013

Roman777, понятно.
Это вы подкрасили ячейки.

А можно - без подкрашиваний ячеек - просто выдать в столбец координаты нужных узлов (без каких-либо дополнительных координат) ?

Дата: Вторник, 12.12.2017, 13:40 | Сообщение № 8

Группа: Проверенные

Ранг: Ветеран

Сообщений: 980

Репутация: 127 ±

Замечаний: 0% ±

Excel 2007, Excel 2013

yl3d,

[vba]

Код

Type point_
    X As Single
    Y As Single
End Type

Sub dsd2()
Dim d
Dim p() As point_
Dim po() As Single
Dim c As Long, r As Long
Dim k As Long, count As Long
Set d = ActiveSheet.Shapes(Cells(5, 26))
With d.DrawingObject.ShapeRange.Nodes
    count = .count
    ReDim p(count)
    For i = 1 To count
        po = .Item(i).Points
        p(i).X = po(1, 1)
        p(i).Y = po(1, 2)
    Next i
End With
r = 8
c = 26
For i = 1 To count
    If i = 1 Or i = count Or (i - 1) Mod 3 = 0 Then
        k = k + 1
        Cells(k + r, c) = p(i).X
        Cells(k + r, c + 1) = p(i).Y
    End If
Next i
End Sub

[/vba]

Много чего не знаю!!!!

Сообщение отредактировал Roman777 - Вторник, 12.12.2017, 13:45

Дата: Вторник, 12.12.2017, 14:16 | Сообщение № 9

Группа: Пользователи

Ранг: Участник

Сообщений: 66

Репутация: 0 ±

Замечаний: 0% ±

Excel 2013

Roman777, теперь работает.
Большое спасибо за помощь.