Как найти угол отрезка полилинии?

Нужно определить между какими вершинами полилинии находится данная точка, ну а там уже чистая математика. Я бы для такой задачи воспользовался лиспом, на котором в отличии от VBA без труда можно определить угол наклона любой кривой или ломаной в любой точке, включая кривые и дуговые сегменты. Например так:

(defun c:seang(/ uPnt sSet sCurve Dr)
  (vl-load-com)
  (if
    (and
    (setq uPnt(getpoint "\nSelect point at curve -> "))
    (setq sSet(ssget uPnt '((0 . "*LINE,ARC,ELLIPSE,CIRCLE")
                  (-4 . "<NOT")(0 . "MLINE")(-4 . "NOT>"))))
    (setq sCurve(vlax-ename->vla-object(ssname sSet 0)))
    (setq Dr(vlax-curve-getFirstDeriv sCurve
        (vlax-curve-getParamAtPoint sCurve uPnt)))
     ); end and
      (princ
    (strcat "\nAngle = "
        (angtos
          (-(/ pi 2)(atan(/(car dr)(cadr dr)))))"°"))
    ); end if
  (princ)
  ); end of c:seang

> {Smirnoff}
Ваш код срабатыват только на, прошу прощения, curve.
А вот как изящно можно решить эту задачу в VBA:
Поместите приведенный код в модуль ThisDrawind,запустите макрос Segment_Angle, и он начнет добросовестно показывать углы ВСЕХ сегментов выбранной полилинии в радианах, начиная с указанного.

Sub Segment_Angle()
    ThisDrawing.SendCommand " _explode "
End Sub
Private Sub AcadDocument_ObjectModified(ByVal Object As Object)
    If (TypeOf Object Is AcadLine) Then
        MsgBox (Object.Angle & " rad")
    End If
End Sub

Ну, а если серьезно, то в задании многовато неизвестных - с какой целью вам это надо, и следовательно, в каком контексте следует решать задачу?

Да, согласен, для линии все очень просто. Но разблокировать полилинию не очень хочется.
А если через уравнения прямых - у меня точка, когда я указываю полилинию, может и не попасть на прямую?

На самом деле так поступать можно. Однако не с помощью SendCommand а:
1. Использовать метод GetEntity для получения объекта полилинии и точки указания.
2. Создать копию полилинию с помощью метода Copy.
3. Взорвать копию объекта с помощью метода Explode при этом получив массив из объектов получившихся после расчленения.
4. Использовать метод SelectAtPoint для повтороного выбора именно примитива прямой.
5. Собственно измерить угол наклона сегмента.
6. Удалить все объекты получившиеся после "взрыва" методом Delete.
При всём при этом надо начиная с пункта 2. разблокировать слой (если заблокирован) на котором лежит расчленяемая полилиния, а в конце операции "Барбароса" воссановить его состояние.
Можно поступить и по другому. Вызвать простую ЛИСП-программу, которая сделает всё без этих лишних манипуляций и передать значение в среду VBA через пользовательский словарь или на худой случай переменную USERRXX.

И это правильно.

Да вроде GetEntity корректирует возвращаемую точку так чтобы она пренадлежала выббранному объекту. Во всяком аналогиченая лисповская функция ENTSEL поступает именно так. Однако погрешность всё равно учитывать надо поскольку производятся вычисления и погрешность накапливается сама собой.

А если разок попробывать?

Sub plExplode()
Dim obj As AcadObject
Dim pt As Variant
Dim exArr As Variant
ThisDrawing.Utility.GetEntity obj, pt, "Разбей эту полилинию >"
exArr = obj.Explode
MsgBox "Получилось линий: " & UBound(exArr) - LBound(exArr) + 1
End Sub

> Gogi
Да однако вы правы, я не замечал этого раньше. Это наверное потому что практически ничего не эксплодил, всегда "забираясь" внутрь объекта. Спасибо.

А позвольте усложнить вопрос.
Если выделяемый отрезок полилинии является дугой. Тут уже не обойтись только вычислением принадлежности точки прямой.

> LeonidSN
Я бы всё таки воспользовался математикой и вычислил бы принадлежность точки отрезку с помощью параметрического уравнения прямой проходящей через две точки ограничив парметр условием 0<=p<=1, естественно с учётом допуска. К сожалению у меня неправильно копируется русский текст (имею ввиду пояснения к функции), но я думаю что аргументы функции понятны их названий. Единственное аргумент Segment если равен True то определяется принадлежность точки отрезку, если False то прямой.

Public Function Asmi_Is_Point_On_Line( _
ByVal X1 As Double, ByVal Y1 As Double, _
ByVal X2 As Double, ByVal Y2 As Double, _
ByVal Xp As Double, ByVal Yp As Double, _
Precision As Double, Segment As Boolean) As Boolean
Dim Tx, Ty As Double
If X2 <> X1 Then
Tx = (Xp - X1) / (X2 - X1)
End If
If Y2 <> Y1 Then
Ty = (Yp - Y1) / (Y2 - Y1)
End If
If X1 = X2 And _
(X1 - Precision <= Xp) And (Xp <= X1 + Precision) Then
Tx = Ty
End If
If Y1 = Y2 And _
(Y1 - Precision <= Yp) And (Yp <= Y1 + Precision) Then
Ty = Tx
End If
If (Ty - Precision <= Tx) And (Tx <= Ty + Precision) _
And (0 - Precision <= Tx) And (Tx <= 1 + Precision) Then
    Asmi_Is_Point_On_Line = True
ElseIf (Ty - Precision <= Tx) And (Tx <= Ty + Precision) _
And Segment = False Then
    Asmi_Is_Point_On_Line = True
Else
    Asmi_Is_Point_On_Line = False
End If
End Function

Вот кстати ещё SEANG дополненый включением-отключением привязки и обработчиком ошибок:

(defun c:seang(/ *error* oldOsm uPnt sSet sCurve Dr)
  (vl-load-com)
  (defun *error*(msg)
    (setvar "OSMODE" oldOsm)
    (princ)
    ); end of *error*
  (setq oldOsm(getvar "OSMODE"))
  (setvar "OSMODE" 512)
  (if
    (and
    (setq uPnt(getpoint "\nSelect point at curve -> "))
    (setq sSet(ssget uPnt '((0 . "*LINE,ARC,ELLIPSE,CIRCLE")
                  (-4 . "<NOT")(0 . "MLINE")(-4 . "NOT>"))))
    (setq sCurve(vlax-ename->vla-object(ssname sSet 0)))
    (setq Dr(vlax-curve-getFirstDeriv sCurve
        (vlax-curve-getParamAtPoint sCurve uPnt)))
     ); end and
      (princ
    (strcat "\nAngle = "
        (angtos
          (-(/ pi 2)(atan(/(car dr)(cadr dr)))))"°"))
    ); end if
  (setvar "OSMODE" oldOsm)
  (princ)
  ); end of c:seang

Я тоже потом подумал что вы это не совсем серьёзно. Да и где время найти чтобы совсем серьёзно:(

> {Smirnoff}
Знаете, по поводу наших с вами выступлений на этой скромной ветке возникает целый ряд соображений, но я не уверен, что... мой настрой разделит большинство.
Однако, попробуем.
Форум есть место обсуждения проблем, а не обязательно вечер вопросов и ответов. Есть, например, общая проблема - взаимоотношения Заказчика и Исполнителя, проблема взаимной ответственности и компетентности. От ее нерешенности страдают многие. Однако, мы предпочитаем ее не замечать!
Конечно, для меня и, возможно, для вас проще всего написать код и таким образом отреагировать на вызовы внешнего мира. Но проблема же не исчезает, Заказчик продолжает считать себя вправе ломать без конца задание на проектирование и относиться наплевательски к работе Исполнителя. Это МЫ позволяем ему так вести себя. Так может быть следует что-то предпринять, чтобы изменить ситуацию? Для начала - обратить на нее внимание.
Возможно, мы недостаточно внимательны друг к другу - вы пишите "> LeonidSN (2006-02-08 23:06:08)
Я бы всё таки воспользовался математикой и вычислил бы принадлежность точки отрезку "
- но это именно то, что сделано в моем предыдущем посте.
Полагаю, что мы все склонны зацикливаться на собственном коде - отсюда, проблемы вызванные ограниченностью. Например, проблема точности вычислений геометрических характеристик. Я с этим сталкивался и убежден, что здесь надо привлекать специалистов по вычислительной математике, но мы продолжаем вариться в собственном соку и кустарничать.
Одним словом, я - за плодотворное обсуждение, а результат придет.

Спасибо большое. Но на данный момент мне хочется реализовать задачу своими силами на VBA.
Я остановился на математическом способе. Дугу буду вычислять через GetBulge.
-----
Мне очень помогли Ваши советы.
И в свете последних обсуждений "клиент-исполнитель" я не прошу выкладывать горы кода. Мне интересно знать, какими методами я могу решить задачу, какими инструментами VBA позволит мне это сделать.

И тему мы, конечно, закрыли, и мои телодвижения выглядят несколько суетливо, но... не надуманная это проблема, вот наткнулся на солидарные настроения:
https://www.caduser.ru/forum/topic15897.html