Алгоритм (не)вхождения точки в произвольный многоугольник.

http://algolist.manual.ru/maths/geom/belong/

ShaggyDoc-у:

Спасибо за действительно инересный (и полезный) сайт

KAI:

Есть еще метод "Подсчета суммы ориентаций пересечений", я пользуюсь уже около 10 лет - пока не подводил...

Комментарии минимальны, но думаю будет понятно...

;;;-----------------------------------------------------------------------
(defun My- (x y)
   (cond
     ((< x y) -1)
     ((> x y)  1)
     (t        0)))
;;;-----------------------------------------------------------------------
(defun My+ (x y)
   (or (zerop x) (zerop y) (zerop (+ x y)) ))
;;;-----------------------------------------------------------------------
(defun In_Figure (pt contur / pt1 pt2 pti ptl ptp ptc eps tmp)
;
; Тест - находится ли точка pt внутри контура contur.
; Алгоритм взят из статьи О.Р.Мусина в журнале
; "Программирование" 4, 91г.
; Выбран алгоритм "Сумма ориентаций пересечений"
;
; Аргументы :
;   contur - список координат точек образующих контур
;            в виде (pt1 pt2 ...ptn)
;   pt     - тестируемая точка
;
; Функции :
;   _locat - проверяет находится ли пара точек в квадрантах
;            ((1,4)(2,4)(1,3))
;   _kk    - вычисляет ориентацию отрезка
;
   (setq tmp nil
         pt1 (mapcar '- (car  contur) pt)
         ptp pt1)
;
; создается список отрезков
;
   (while contur
     (setq ptc    (mapcar '- (car contur) pt)
           contur (cdr contur))
     (if (_locat ptc ptp)
       (setq tmp (cons (list ptc ptp) tmp)))
     (setq ptp ptc))
   (if (_locat pt1 ptp)
     (setq tmp (cons (list pt1 ptp) tmp)))
;
; ищем точки пересечения L+ с контуром
;
   (setq pt  '(0 0 0)
         ptl '(1 0 0)
         eps 0)
;
   (while tmp
     (setq pt1 (caar  tmp)
           pt2 (cadar tmp)
           tmp (cdr   tmp)
           pti (inters pt1 pt2 pt ptl nil))
     (cond
       ((< (car pti) 0) nil)                  ; Отрезок пересекает L-
       (t (setq eps (+ (_kk pt1 pt2) eps))))) ;
;
; В eps - сформированный признак
;
   (not (zerop eps)))
;;;-----------------------------------------------------------------------
(defun _Locat (pt1 pt2);
;
; Допустимая ли комбинация четвертей ?
;
   (cond
     ((and (>= (car pt1) 0) (>= (cadr pt1) 0))           ; 1
      (or (and (>= (car pt2) 0) (< (cadr pt2) 0))        ; 1-4
          (and (<  (car pt2) 0) (< (cadr pt2) 0))))      ; 1-3
     ((and (<  (car pt1) 0) (>= (cadr pt1) 0))           ; 2
      (and (>= (car pt2) 0) (<  (cadr pt2) 0)))          ; 2-4
     ((and (<  (car pt1) 0) (<  (cadr pt1) 0))           ; 3
      (and (>= (car pt2) 0) (>= (cadr pt2) 0)))          ; 3-1
     (t                                                  ; 4
      (or (and (>= (car pt2) 0) (>= (cadr pt2) 0))       ; 4-1
          (and (<  (car pt2) 0) (>= (cadr pt2) 0)))) ))  ; 4-2
;;;-----------------------------------------------------------------------
(defun _Kk (pt1 pt2);
   (if (>= (cadr pt1) (cadr pt2)) 1 -1))

Спасибо всем за добрые советы.
Программа г.Попадьина протестирована, прекрасно работает, но мне нужен был анализ еще и нахождения исходной точки на контуре, а данный алгоритм для точки на контуре выдает то nil то Т.
После сбора алгоритмов остановился все-таки на описанном в http://algolist.manual.ru/maths/geom/belong/, кое-какие идеи подкинули также дочь со товарищи.
Но к данному алгоритму пришлось добавить не описанный  никем анализ, когда имеем горизонтальный(е) участок(и), пересекаемые лучом от исходной точки, а участки до и после горизонта направлены в разные стороны.
Кому интересно можете скачать функцию http://geol-dh.narod.ru/spds/index.html (довольно большая получилась)
На входе: точка, список точек контура, точность сравнения координат
Возвращает список: флаг, координаты точки на контуре, описание точки на контуре

> "еще
и нахождения исходной точки на контуре"
Можно попробовать без математики:
(if (vl-catch-all-error-p
      (vl-catch-all-apply
        'vlax-safearray->list
        (list (vlax-variant-value
                (vla-intersectwith (vlax-ename->vla-object pt) (vlax-ename->vla-object pline) acextendnone)
              ) ;_  vlax-variant-value
        ) ;_  list
      ) ;_  vl-catch-all-apply
    ) ;_  vl-catch-all-error-p
  nil ;_ точка не лежит...
  t ;_ точка лежит...
) ;_  if
здесь функция vl-catch-all-apply вернет или список с координатами точки (в смысле пересечения точки и полилинии) или ошибку, если точка не на полилинии.

> Сергей
Попадьин
Это действительно вариант решения для реальных объектов. Создать реальный контур - дело двух-трех строк программы. А вот как быть с ошибками?...