И снова полинии

;|****************** In_Figure *****************************
  * Тест — находится ли точка pt внутри контура contur.    *
  * Тема поднималась здесь                                 *
  * https://www.caduser.ru/forum/topic4008.html    *
  * Алгоритм взят из статьи О.Р.Мусина в журнале           *
  * "Программирование" 4, 91г.                             *
  * Выбран алгоритм "Сумма ориентаций пересечений"         *
  **********************************************************
* Аргументы [Тип] :
  pt     — тестируемая точка (X Y Z) [list]
  contur — список координат точек образующих контур
           в виде (pt1 pt2 ...ptn) [list]
* Возвращает
  t   - точка в контуре
  nil -  точка вне контура
* Функции :
 _locat — проверяет находится ли пара точек в квадрантах
* ((1,4)(2,4)(1,3))
 _kk  — вычисляет ориентацию отрезка
***********************************************************|;
(defun In_Figure (pt contur / pt1 pt2 pti ptl ptp ptc eps tmp)
;;;----------------------------------------------------------
  (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 _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))
;_------------------------------------------------------------
  (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));_while
  (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))))
    );_while
;_ В eps — сформированный признак
  (not (zerop eps))
)
;;======================================================;;
;;  Return list of segms and radii valiues of polyline  ;;
;;  written by Fatty The Old Horse 10/13/05    ;;
;;      (framework)      ;;
;;======================================================;;
;;      helper functions  ;;
;; group list by number
(defun lib:group-by-num (lst num / ls ret)
  (if (= (rem (length lst) num ) 0)
    (progn
      (setq ls nil)
      (repeat (/ (length lst) num)
  (repeat num (setq ls
        (cons (car lst) ls)
        lst (cdr lst)))
  (setq ret (append ret (list (reverse ls)))
        ls nil)))
    )
ret
  )
;;;Отрисовка "невидимых" линий
(defun c:vis (/ _clist points p1 p2 i lines quantity_points len crs pl adoc)
  (VL-LOAD-COM)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (setq *old_osnap* (getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (setq pline (car (entsel "\nУкажите полилинию контура: "))
    pl (vlax-ename->vla-object pline))
  (setq crs (lib:group-by-num (vlax-get pl 'Coordinates)(if (= (vla-get-ObjectName pl) "AcDbPolyline") 2 3)))
  (setq p1 (getpoint "\nНачальная точка линии"))
  (setq p2 (getpoint p1 "\nКонечная точка линии"))
  (vl-cmdf "_.line" p1 p2 "")
  (setq liine (entlast))
  (setq points (vlax-variant-value (vla-intersectwith(vlax-ename->vla-object liine)
    (vlax-ename->vla-object pline) acextendnone )))
   (setq points (if (> (vlax-safearray-get-u-bound points 1) 0)(vlax-safearray->list points) nil))
  (if points
    (progn
      (setq points (lib:group-by-num points 3)
        p1 (cdr(assoc 10 (entget liine))))
      (setq lst (append points (list p1 (cdr(assoc 11 (entget liine))))))
      (setq lst (vl-sort lst '(lambda (pt1 pt2)(< (distance pt1 p1)(distance pt2 p1)))))
      (setq p1 (car lst))
      (entdel liine)
      (foreach item (cdr lst)
    (setq liine (vla-addline (vla-ObjectIDToObject adoc (vla-get-OwnerID pl))
      (vlax-3d-point p1)(vlax-3d-point item)))
    (setq p2 (polar p1 (angle p1 item)(* 0.5 (distance p1 item))))
    (if (In_Figure p2 crs)
      (progn ;_Внутри контура полилинии
        (vla-put-Color liine acRed) ;_Меняем цвет
        )
      )
    (setq p1 item)
    )
      )
    )
  (princ)
  )