;;;*--------------------------------------------------------------------------------------------
;;;* Формирование списка точек выпуклого многоугольника по краям заданного списком массива точек
;;;* (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
 |
|
СПДС. Функция CONVEX_POLYGON_PTS
