Главная СПДС СПДС. Функция CONVEX_POLYGON_PTS

;;;*-------------------------------------------------------------------------------------------- 
;;;* Формирование списка точек выпуклого многоугольника по краям заданного списком массива точек 
;;;* (C)KAI, 2005 г. (413-2) 65-05-10 Магадан. http://geol-dh.narod.ru/                          
;;;*-------------------------------------------------------------------------------------------- 
(defun CONVEX_POLYGON_PTS (pt_lst prec / i flag polpt_lst min-y max-y direct
                                         maxloop loop min_angle last_pt
                                         temp_lst next_last_pt rem_pt_lst pti ang)
  ; Параметры:
  ;  pt_lst - список массива точек в текущей UCS (можно сдвоенные точки) или nil
  ;           список должен содержать как минимум двумерные точки (проверки на это в функции
  ;           не делается)
  ;           пример списка: ((12.3 12.5 16.3) (45.6 16.9 78.9)...(12.5 16.5 87.2))
  ;  prec -   точность сравнения координат (точек, лежащих на одной прямой или 
  ;           конечных точек), = 0.000000001
 
  ; Возвращает:
  ;   список точек выпуклого многоугольника (явное замыкание на первую точку),
  ;   или nil, если он на входе, или 1 или 2 точки (в том числе, если все исходные точки
  ;   массива лежат на одной прямой, параллельной оси X или Y.
  ; Формат списка такой же как на входе

  ; Обрабатываем массив из 3-х и более точек, если точек в массиве меньше -
  ;   список точек полигона будет содержать только заданные точки массива (одну или две).
  ; Координаты Z точек многоугольника наследуют соответствующие координаты Z исходной точки
  ;   (первой, то есть самой нижней).

  ; Исключения: если ряд точек массива лежат на полигоне, не обязательно они все будут
  ;             перечислены в списке.

  ; Выполняем проверку: параллельны ли все точки осям X или Y
  (if (> (length pt_lst) 2)
    (progn
      ; Сортируем список точек по возрастанию X координаты
      (setq pt_lst (vl-sort pt_lst '(lambda (e1 e2) (< (car e1) (car e2)))))
      ; Одинаковые X координаты у всех точек массива?
      (if (equal (car (car pt_lst)) (car (last pt_lst)) prec)
        (setq flag "Y"
             ; Ищем начало и конец вертикальной линии из точек
              pt_lst (vl-sort pt_lst '(lambda (e1 e2) (< (cadr e1) (cadr e2))))
              pt_lst (list (car pt_lst) (last pt_lst)) ; И на выходе выдаем список из 2-х точек
        ) ; setq
      )
    )
  )
  (if (> (length pt_lst) 2) ; Выполняем то же для проверки на горизонтальность
    (progn
      (setq pt_lst (vl-sort pt_lst '(lambda (e1 e2) (< (cadr e1) (cadr e2)))) ; По Y координате
            pt_lst ($_NOT_DUPLICATE pt_lst prec)
      ) ; setq
      (if (equal (cadr (car pt_lst)) (cadr (last pt_lst)) prec)
        (progn
          (setq flag "X"
                pt_lst (vl-sort pt_lst '(lambda (e1 e2) (< (car e1) (car e2))))
                pt_lst (list (car pt_lst) (last pt_lst))
          ) ; setq
        )
      )
    )
  )
  (if flag
    (alert (strcat "All points of block objects lie on straight line that parallel to axis" " " flag "."))
  )
  ; Список точек уже отсортировант по Y
  (if (> (length pt_lst) 2)
    (progn
      (setq 1st_pt (car pt_lst)        ; 1-я точка полигона (самая нижняя из списка точек)
            polpt_lst (list 1st_pt)    ; Начальный список полигона (пока из 1-й точки)
            min_y (cadr 1st_pt)        ; Минимальная координата Y массива точек
            max_y (cadr (last pt_lst)) ; Максимальная координата Y массива точек
            ; Задаем предварительное направление поиска следующей точки полигона
            direct nil ; (nil - вверх от начальной точки, T - вниз от самой верхней ПРАВОЙ точки)
      ) ;setq
      ; На всякий случай ограничиваем цикл (вдруг что-то не так, функция могла-бы крутиться вечно).
      (setq maxloop (1+ (length pt_lst))
            loop 0
      ) ; setq
      ; Пока найденная следующая точка полигона не равна первой формируем список точек:
      (while (and (< loop maxloop) (not (equal next_last_pt (last polpt_lst) prec)))
        (setq min_angle (* PI 2.0)    ; Мин. угол инициируем как максимально возможный
              last_pt (car polpt_lst) ; Последняя найденная точка полигона
        ) ; setq
        (if direct ; Ведем поиск точек многоугольника вниз по оси Y
          (progn
            (if (equal (cadr last_pt) max_y prec)
              (progn
                ; Ищем еще точки массива с максимальной координатой Y (вдруг есть)
                (setq temp_lst (vl-remove-if-not '(lambda (x) (equal (cadr x) max_y prec)) pt_lst)
                      ; Сотрируем по X (по возрастанию)
                      temp_lst (vl-sort temp_lst '(lambda (e1 e2) (< (car e1) (car e2))))
                ) ; setq
                ; И если есть еще (кроме первой найденной)
                (if (not (equal (car temp_lst) last_pt prec))
                  ; Вводим первую в список найденных точек контура многоугольника
                  (setq next_last_pt (car temp_lst)
                       ; Добавляем найденную точку в список точек полигона
                        polpt_lst (cons next_last_pt polpt_lst)
                        last_pt (car polpt_lst) ; Теперь уже последняя точка будет эта
                  ) ; setq
                )
              )
            )
            ; Будем проверять только точки, лежащие не выше последней найденной точки, 
            ; остальные отбрасываем из списка для поиска
            (setq rem_pt_lst (cdr (member last_pt pt_lst))
            ; Удаляем уже найденную точку полигона из общего списка точек
                  pt_lst (vl-remove next_last_pt pt_lst)
                  i 0
            )
            ; Последовательно проверяем все оставшиеся точки массива
            (while (setq pti (nth i rem_pt_lst))
              (setq ang (angle last_pt pti))
              (if (and (<= ang min_angle)
                       ; Отбрасываем все нулевые углы (они и так они заведомо будут наименьшие)
                       (not (equal ang 0 prec)) 
                       )
                (setq min_angle ang ; Это будет самый маленький угол из всех точек (пока)
                      next_last_pt pti
                ) ; setq
              )
              (setq i (1+ i))
            ) ; while
            ; Прошли все точки, нашли минимальный угол и соответствующую ему точку
          )
        )
        (if (not direct) ; Ведем поиск точек многоугольника вверх по оси Y
          (progn
            ; Будем проверять только точки, лежащие не ниже последней найденной точки,
            ; остальные отбрасываем из списка для поиска
            (setq rem_pt_lst (cdr (member last_pt pt_lst))
                  ; Удаляем уже найденную точку полигона из общего списка точек
                  pt_lst (vl-remove next_last_pt pt_lst)
                  i 0
            ) ; setq
            ; Последовательно проверяем все оставшиеся точки массива
            (while (and rem_pt_lst (setq pti (nth i rem_pt_lst)))
              (setq ang (angle last_pt pti))
              (if (<= ang min_angle)
                (setq min_angle ang
                      next_last_pt pti
                ) ; setq
              )
              (setq i (1+ i))
            ) ; while
            ; Прошли все точки, нашли минимальный угол и соответствующую ему точку
            ; Как только дойдем до верхней точки (max. Y) то:
            (if (= (cadr next_last_pt) max_y)
              (progn
                ; Далее формирование списка точек многоугольника идет вниз,
                ; правая ветвь сформирована
                (setq direct T
                      ; И добавляем в список последнюю найденную и начальную точку
                      pt_lst (append (list next_last_pt) pt_lst (list 1st_pt))
                      ; И список оставшихся для анализа точек будет уже по убыванию координаты Y
                      pt_lst (vl-sort pt_lst '(lambda (e1 e2) (> (cadr e1) (cadr e2))))
                ) ; setq
              )
            )
          )
        )
        ; Поиск очередной точки полигона завершен
        ; Добавляем найденную точку в список точек полигона
        (setq polpt_lst (cons next_last_pt polpt_lst))
        ; Как только дойдем до координаты Y нижней точки 
        (if (and direct (equal (cadr next_last_pt) (cadr 1st_pt) prec))
          (progn
            ; Игнорируем точки (если имеются) между последней найденной и первой.
            ; Последнюю точку контура приравниваем 1-й точке (т.е. явно замыкаем многоугольник)
            (setq next_last_pt 1st_pt
                  polpt_lst (cons next_last_pt polpt_lst) ; формируем конечный список точек полизога
            ) ; setq
          )
        )
        (setq loop (1+ loop))
      ) ; while
      (if (>= loop maxloop) ; Если что-то не сработало, так хоть предупредим
        (alert (strcat "Attempt to calculate infinite cycle (function CONVEX_POLYGON_PTS)!
                       Call author of programm.")) 
      )
      ; В завершении отбрасываем последнюю начальную точку полигона (мы ее добавили 2 раза)
      ; и переворачиваем список (полигон будет формироваться против часовой стрелки)
      (setq polpt_lst (reverse (cdr polpt_lst)))
    )
    (setq polpt_lst pt_lst) ; Если точек 1, 2, или пустой список
  )
  ; Возвращаем список точек выпуклого многоугольника, 1 или 2 точки, или nil (если он на входе)
  polpt_lst 
) ; end of *** CONVEX_POLYGON_PTS ***

(defun c:test ( / ss) ;команда для проверки действия функции
  (princ (strcat "\n" "Select points: "))
  (setq ss (ssget (list (cons 0  "POINT")))) ;выбираем только точки
  (if ss
    (progn
      (setq ll nil)
      (setq i 0)
      (while (setq en (ssname ss i))
        (setq enl (entget en))
        (setq ll (cons (cdr (assoc 10 enl)) ll))
        (setq i (1+ i))
      );while i
    )
  )
  (if ll
    (progn
      (setq cont_lst (CONVEX_POLYGON_PTS ll 0.0000001))
      (print cont_lst)(princ " <- список, возвращаемый функцией CONVEX_POLYGON_PTS")
      (command "._PLINE" (car cont_lst)) ;отрисовываем полилинию по списку, возвращаемому функцией CONVEX_POLYGON_PTS
        (foreach n (cdr cont_lst) (command n))
      (command)
    )
  )
  (prin1)
);end of c:test

  при полном или частичном использовании материалов сайта ссылка на источник обязательна ©2002-2012