[Tonic]

Добрый день!
Возникла следующая проблема: получился циклический алгоритм с неизвестным числом повторений. Но, возможно, это лишь предположение. Дело вот в чём: имеются определённые отрезки с расширенными данными, в которых записана их высота (вместо координаты Z). Другими словами:
1. Имеем список LIST1 с именами построенных в ходе программы отрезков;
2. Организовываем repeat по количеству элементов LIST1
3. С помощью ssget (секущей выступает элемент i списка LIST) получаем список пересекающих отрезков
4. Далее нужно сделать следующее: если высота пересекающего сегмент i отрезка меньше, чем высота отрезка i, то с помощью написанной функции разрываем этот отрезок; Если равна - ничего не делаем; Если больше - разрываем сам сегмент.

Проблема в разрыве самого сегмента: ведь если вместо него образуется 2 новых отрезка, нельзя в этом же цикле узнать, пересекаются ли они с другими отрезками или нет - получается, нужно снова делать вложенный цикл и так далее. Может, правильно использовать рекурсию? Но я её никогда не применял. Или тайны итераций?

Вот схематичный набросок куска программы:

Код:

[Выделить все]

(setq vsz (getvar "VIEWSIZE") vct (getvar "VIEWCTR"))
(setq i 0)
(repeat (length trub_list_all); Цикл по количеству построенных отрезков
    (setq pip_1040 (cdr (assoc 1040 (cdadr (assoc -3 (entget (nth i trub_list_all) '("Appl"))))))); Высота отрезка i
    ;Точки начала, конца отрезка i (p1, p2), а также точки для создания будущей рамки для ssget (иначе не всегда работает):
    (setq p1 (vlax-curve-getStartPoint (vlax-ename->vla-object (nth i trub_list_all)))
	  p2 (vlax-curve-getEndPoint (vlax-ename->vla-object (nth i trub_list_all))))
    (setq p3 (list (- (min (nth 0 p1) (nth 0 p2)) 100) (- (min (nth 1 p1) (nth 1 p2)) 100))
	  p4 (list (+ (max (nth 0 p1) (nth 0 p2)) 100) (+ (max (nth 1 p1) (nth 1 p2)) 100)))
    (vl-cmdf "_zoom" "_W" p3 p4)
    (setq nab1 (ssget "_F" (list p1 p2))); Ищем пересекающие отрезок i элементы
    (if nab1
      (progn
	(setq nab1_list (ss-to-list nab1)); Преобразование набора в список с помощью функции
	(setq nab1_list (vl-remove-if (function (lambda (x) (OR (not (eq (cdr (assoc 0 (entget x))) "LINE"))
			(= (cdr (assoc 1040 (cdadr (assoc -3 (entget x '("Appl")))))) pip_1040))))
	nab1_list)); удаляем лишние элементы из списка пересекающих

; Если пересекающий отрезок по высоте меньше отрезка i, разрываем его с помощью функции PRER:
   (if nab1_list (foreach item nab1_list (setq int_pt (inters p1 p2 (setq p3 (vlax-curve-getStartPoint (vlax-ename->vla-object item)))
						      (setq p4 (vlax-curve-getEndPoint (vlax-ename->vla-object item)))))
					      (if (< (cdr (assoc 1040 (cdadr (assoc -3 (entget item '("Appl")))))) pip_1040)
						(prer item int_pt 100))))
; Если пересекающий отрезок по высоте выше отрезка i, разрываем отрезок с помощью функции PRER:
(if nab1_list (foreach item nab1_list (setq int_pt (inters p1 p2 (setq p3 (vlax-curve-getStartPoint (vlax-ename->vla-object item)))
						      (setq p4 (vlax-curve-getEndPoint (vlax-ename->vla-object item)))))
					      (if (> (cdr (assoc 1040 (cdadr (assoc -3 (entget item '("Appl")))))) pip_1040)
						(prer (nth i trub_list_all)  int_pt 100))))

Проблема: функция prer возвращает списов из двух новых отрезков (после разрыва этой же функцией передаваемого ей отрезка). Т.е. получается, что отрезка (nth i trub_list_all) на данном этапе итерации не существует, а ведь надо и дальше проверять его на предмет пересечений!

[VVA]

Проблема в разрыве самого сегмента: ведь если вместо него образуется 2 новых отрезка, нельзя в этом же цикле узнать, пересекаются ли они с другими отрезками или нет

А зачем? Ведь с п.3 ты уже получил список пересекающих отрезков?
Для поиска отрезков используй ssget с опцией _Fence. С помощью ssnamex получишь имена объектов и точки пересечения

_$ (setq ss (ssget "_F" (list pt1 pt2))) <Selection set: 3> _$ (ssnamex ss) ((4 <Имя объекта: 7ef84e48> 0 (0 (240.973 94.5129 0.0))) (4 <Имя объекта: 7ef84e50> 0 (0 (292.078 107.02 0.0))) (4 <Имя объекта: 7ef84e40> 0 (0 (-1540.24 -799.078 0.0)))) _$

Разбиваешь после этого отрезок или нет не имеет уже значения
Это один вариант. Если используешь отрезки, то можно решать задачу или ее часть геометрически, используя inters

[Tonic]

Сообщение от VVA А зачем? Ведь с п.3 ты уже получил список пересекающих отрезков?

Да, но если окажется, что отрезок i пересекает 2 линии, которые выше его, то его надо разорвать в 2 местах, получив 3 отрезка - причём, последовательно, но это невозможно, так как итерация заканчивается после первого же разрыва.

Сообщение от VVA Для поиска отрезков используй ssget с опцией _Fence. С помощью ssnamex получишь имена объектов и точки пересечения

Да, кстати: программу пишу под Bricscad, а там всё никак не сделают ssnamex =)

Сообщение от VVA Разбиваешь после этого отрезок или нет не имеет уже значения Это один вариант. Если используешь отрезки, то можно решать задачу или ее часть геометрически, используя inters

Эту часть не понял.

P.S. Вот приблизительный рисунок - то, как должно всё выглядеть окончательно (схематично). Цифры - это условная высота линий.

[VVA]

Tonic, Посмотри здесь функции mip:mark и mip:get-last-ss.
Алгоритм примерно такой:
Если принято решение рвать отрезок, то
1. Ставим метку (mip:mark)
2. Рвем
3. Берем новые появившиеся отрезки (mip:get-last-ss) и что-то с ними делаем
Но я бы делал не так.
Отрезки не рвал, а вычислял точки и создавал с помощью entmakex (пример)
(Обрати внимание, не enmake , а entmakeX)
Небольшой пример. Нарисуй отрезок (назовем его основной). Нарисуй некоторе количество пересекающих его отрезков. Команда разорвет основной отрезок в местах пересечения с каждым нечетным пересекающим отрезком.

Код:

[Выделить все]

(defun C:TEST ()
  (vl-load-com)
(setq line1 (car (entsel "\nУкажи основной отрезок :")))
(setq pat (entget line1)) ;_шаблон
(setq delta 1) ;_Отступ на сколько рвем
(setq pt1 (cdr(assoc 10 (entget line1))))
(setq pt2 (cdr(assoc 11 (entget line1))))  
(setq ss (ssget "_F" (list pt1 pt2)))
;;Удаляем наш отрезок
(setq ss (ssdel line1 ss))
(setq lst nil tmp nil)
(setq i (sslength ss))  
(repeat (sslength ss)
  (setq lst (cons (ssname ss (setq i (1- i))) lst))
  )
  (setq i 0)
 (foreach item lst
   (setq i (1+ i))
   (if (= (logand i 1) 1) ;_Нечетный рвем отрезок line1
     (progn
       (setq pt1-1 (cdr(assoc 10 (entget item))))
       (setq pt1-2 (cdr(assoc 11 (entget item))))
       (setq ptC (inters pt1 pt2 pt1-1 pt1-2))
       (setq ptNew-1 (polar ptC (angle ptC pt1) delta))
       (setq ptNew-2 (polar ptC (angle ptC pt2) delta))
       (setq tmp (cons (list pt1 ptNew-1) tmp))
       (setq pt1 ptNew-2) ;_Смещаем начальную точку
       )
     )
   )
  ;;;Итого в tmp список новых точек отрезка ine1
  (if tmp ;;_что-то еть отрезок line1 рвется
    (progn
       (setq tmp (cons (list pt1 pt2) tmp))
      ;;;Рассматриваем точки попарно (посегменоно
      (foreach seg tmp
        ;;;Меняем точки в шаблоне
        (setq i pat)
        ;;;Начальную
        (setq i (subst (cons 10 (car seg))(assoc 10 i) i))
        ;;;Конечную
        (setq i (subst (cons 11 (cadr seg))(assoc 11 i) i))
        (entmakex i)
       )
      (entdel line1)
        )
      )
    )

[Tonic]

VVA, спасибо! Это как раз то, что нужно.