[Tonic]

На чертеже имеются последовательно построенные отрезки и дуги (сопряжённые). Необходимо каким-то образом после запроса о выделении одного из сегментов цепочки узнать имена всех сопряжённых примитивов в этой цепочке (например, чтобы преобразовать это всё в полилинию).
Фокусы, которые у меня не прошли:
(для краткости P1 и Р2 - начальная и конечная точки выделенного примитива)

- создание фильтра для отлова примитивов, проходящих через точки Р1 или Р2 (отлавливается всего один примитив);
- создание фильтра для примитивов методом "W" (окошком), где область окошка задаётся вокруг точки Р1 или Р2 с расстоянием 0.00001 мм на 0,00001 мм (примитивы не попадают в эту область до тех пор, пока окошко не сделается слишком большим, а это уже риск отловить лишние примитивы);
- создание списка соседей выделенного примитива: он у меня, во-первых, плохо работает, а во-вторых, после этого нужно искать соседей для найдённых соседей, отфильтровывая предыдущие примитивы, и так далее по неведомому циклу;

Может, есть ещё варианты? Сталкивался кто-нибудь с подобной задачей?

[VVA]

Если правильно понял, см
PL-CSE
А прототип был выложен здесь в #69 и #74

[Tonic]

Это интересный вариант, только у меня два вопроса:
1. Выбирать необходимо только первый или последний сегмент? Почему нельзя любой? При попытке указания другого сегмента происходит объединение только части сегментов.
2. На что влияет fuzz? У меня при значении 0 всё нормально работает - так можно ли её вообще убрать из программы?

[VVA]

1.Так было задумано. Для любого см CSS CSP из # 69
2. На точность прилегания вершин объединяемых примитивов друг к другу. Если уверен, что всегда будет абсолютно точное совпадения начала/конца, то можно и убрать.

[Tonic]

Программа из #69 тоже запрашивает первый или последний примитив в цепи, и если указать примитив из середины, происходит объединение только части сегментов.

[Tonic]

Есть ли смысл у строки
(setq ss (ssget "_I") ss nil ss (ssget "_X" '((0 . "ARC,LINE,*POLYLINE"))))
?
Почему не (setq ss (ssget "_X" '((0 . "ARC,LINE,*POLYLINE"))))
?
Как-то запутанно всё =)

Также непонятно, как может использоваться переменная pt, если её сделали nil:

Код:

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

(cond ((= (type pt) 'ENAME)
       (setq ln (vlax-ename->vla-object pt)
             pt nil
             )
       )
      ((= (type pt) 'VLA-OBJECT)(setq ln pt pt nil))
      (t nil))
(if (setq ss (ssget "_I")
          ss nil
          ss (ssget "_X" '((0 . "ARC,LINE,*POLYLINE")))
    ) ;_ end of setq
  (progn
    (if pt
      (progn...

...(vlax-3d-point pt)

[VVA]

Посмотри измененный алгоритм в #121

[VVA]

Сообщение от Tonic Есть ли смысл у строки (setq ss (ssget "_I") ss nil ss (ssget "_X" '((0 . "ARC,LINE,*POLYLINE")))) ? Почему не (setq ss (ssget "_X" '((0 . "ARC,LINE,*POLYLINE")))) ? Как-то запутанно всё =)

(setq ss (ssget "_I") - не учитываем предварительно выбранные объекты (так задумано)
ss nil - эта привычка выработалась со времен 10 Автокада, когда одновременно открытых наборов могло быть не больше 5. Сейчас их намного больше, но число все равно конечно. Цитата из хелпа, выделение мое

The selected objects are highlighted only when ssget is used with no arguments. Selection sets consume AutoCAD temporary file slots, so AutoLISP is not permitted to have more than 128 open at one time. If this limit is reached, AutoCAD cannot create any more selection sets and returns nil to all ssget calls. To close an unnecessary selection set variable, set it to nil.

Поэтому считаю хорошим тоном даже сейчас явно обнулять переменные наборов

[Tonic]

Всё равно не понимаю:
(setq ss (ssget "_I") ss nil ss (ssget "_X" '((0 . "ARC,LINE,*POLYLINE"))))
в итоге всё равно переменной ss присваивается набор дуг и линий, так зачем создавать набор из подсвеченных примитивов и сразу же его удалять?

[VVA]

Посмотри в справке, что делает (ssget "_I") .
Я таким образом избавляюсь от предварительно выбранных объектов

[Tonic]

"I" - текущий набор из объектов, отмеченных с помощью ручек.
Значит, сначала присваиваем набору ss один выделенный примитив, затем тут же обнуляем набор, а потом создаём набор из всех дуг и линий, включая выделенный примитив. Зачем такая последовательность, если ничего не изменится, если написать просто (setq ss (ssget "_X" '((0 . "ARC,LINE,*POLYLINE"))))?

[VVA]

Все не так. Но можешь заменить как ты хочешь. Тоже будет работать

[Tonic]

Всё не так, а как? Интересно же =)

Ну я и планировал оставить всё только самое необходимое и упростить, а всё так запутанно, что это сделать не так просто. Например, неясен смысл функций mip:get-last-ss и mip:mark, все конструкции замысловаты =)

P.S. Какая версия программы самая лучшая? №69, №74 или последняя? Чем они отличаются и какая стабильней работает?

[Tonic]

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

Код:

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

(cond ((= (type pt) 'ENAME)
       (setq ln (vlax-ename->vla-object pt)
             pt nil
             )
       )
      ((= (type pt) 'VLA-OBJECT)(setq ln pt pt nil))
      (t nil))

Код:

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

    (setq line_lst  (mapcar 'vlax-ename->vla-object
                             (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
                     ) ;_ end of mapcar

Код:

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

chain_list (cons ln chain_list )

Код:

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

    (mapcar '(lambda (pt_Pattern line_list)
    (setq cycl 0)
     (while
        (setq couple
               (vl-remove-if-not
                 (function (lambda (x)
                             (or (equal (vlax-curve-getStartPoint x) pt_Pattern fuzz)
                                 (equal (vlax-curve-getEndPoint x) pt_Pattern fuzz))
                           ) ;_ end of lambda
                 ) ;_ end of function
                 line_list
               ) ;_ end of vl-remove-if-not
        ) ;_ end of setq

       (grtext -1 (strcat "Обработка. Цикл - " (itoa (setq cycl (1+ cycl)))))
       (if couple
           (progn
             (setq chain_list (cons (car couple) chain_list))
             (setq ln (car chain_list))
             (setq line_list (vl-remove ln line_list))
             (setq pt_Pattern (if (equal pt_Pattern (vlax-curve-getStartPoint ln) 1e-6)
                                (vlax-curve-getEndPoint ln)
                                (vlax-curve-getStartPoint ln)
                                )
                   )
           ) ;_ end of progn
         ) ;_ end of if
      ) ;_ end of while
               )
            (list
              (setq pt_pattern (vlax-curve-getStartPoint ln))
              (vlax-curve-getEndPoint ln)
              )
            (list line_lst line_lst)
            )

Код:

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

   (if (setq *mip:mark (entlast))
      nil
      (progn (entmake '((0 . "point") (10 0.0 0.0 0.0)))
             (setq *mip:mark (entlast))
             (entdel *mip:mark)
      )

Код:

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

(defun mip:get-last-ss (/ ss tmp)
   (if *mip:mark
      (progn (setq ss (ssadd))
             (while (setq *mip:mark (entnext *mip:mark)) (ssadd *mip:mark ss))
             (command "._select" ss "")
             (setq tmp ss)
      )
      (alert "*mip:mark not set. \n run (mip:mark) before mip:get-last-ss.")
   )
)

Код:

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

   (setq lst (vl-remove-if 'vlax-erased-p lst))
  (if (setq ss nil ss (mip:get-last-ss))
    (progn
      (if lst
        (foreach item lst (ssadd (vlax-vla-object->ename item) ss)))
      (sssetfirst ss ss)))

[VVA]

Ничего себе кусочки. Нумерация сверху
1. Чистый выход из cond. Если ни одно условие выше не ИСТИНА, то T - вернет ИСТИНУ
2. Преобразование набора примитивов в список примитивов. Удалить из списка элементов все элементы, которые являются списками. Смотри возврат ф-ции ssnamex
3. Добавляем ln в начало списка chain_list
4.

(mapcar '(lambda (pt_Pattern line_list)

- учи матчасть mapcar и lambda

(while (setq couple (vl-remove-if-not (function (lambda (x) (or (equal (vlax-curve-getStartPoint x) pt_Pattern fuzz) (equal (vlax-curve-getEndPoint x) pt_Pattern fuzz)) ) ;_ end of lambda ) ;_ end of function line_list ) ;_ end of vl-remove-if-not ) ;_ end of setq

Циклим, пока в списке выбранных примитивов line_list находим примитивы, начало или конец которых совпадают с точкой-шаблоном pt_Pattern

(if couple (progn (setq chain_list (cons (car couple) chain_list)) (setq ln (car chain_list)) (setq line_list (vl-remove ln line_list)) (setq pt_Pattern (if (equal pt_Pattern (vlax-curve-getStartPoint ln) 1e-6) (vlax-curve-getEndPoint ln) (vlax-curve-getStartPoint ln) )

Если нашли что-то, то добавляем это что-то [(setq ln (car chain_list))]
в нацу цепочку chain_list. Устанавливаем новую точку-шаблон на несовпадающий начало или конец чего-мы-тим-нашли (ln)
И циклим (см. выше)

(list (setq pt_pattern (vlax-curve-getStartPoint ln)) (vlax-curve-getEndPoint ln) ) (list line_lst line_lst)

Учи mapcar
5,6,7 - Нужно, чтобы подсветить результат грипсами

[Tonic]

VVA, спасибо! mapcar и lambda действительно требуют углубленного изучения - как-то не приходилось их использовать раньше.

[VVA]

Изучи непременно, откроешь новую страницу в программировании.

[VVA]

Почитай здесь про mapcar и lambda