[Tonic]

Добрый день всем!
Второй день мучений вынудил меня прибегнуть к помощи умудрённых опытом =)
Имеется список вида:

Код:

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

((<Имя объекта: 7ef8a5b0> (-6684.89 14125.2 0.0) (-5621.34 13584.9 0.0))
 (<Имя объекта: 7ef8a628> (-5621.34 13584.9 0.0) (-5204.81 12688.2 0.0)) ...)

,
содержащий имя объекта - дуги или отрезка - и его начальную и конечную точки. Причём все эти отрезки и дуги достоверно представляют собой последовательно соединённые звенья, возможно, с небольшим допуском.
Так вот - как отсортировать этот список, чтобы в итоге он представлял собой последовательность имён примитивов от начального к конечному (или наоборот - не так важно)?
У всех отрезков/дуг, кроме первого и последнего, имеются, конечно, общие точки - как-то, наверно, надо сделать vl-sort с lambda, учитывая этот параметр. А вот как - я что-то не могу сообразить.

[VVA]

Посмотри команду CSS здесь В ф-ции ChainSelectFromAny1 есть нужный тебе алгоритм

[Tonic]

Хорошая функция - я её использовал. Но в данном случае она не подходит, т.к. на самом деле точки последовательных сегментов (отрезков и дуг) на чертеже не совпадают (они разорваны другими отрезками), однако содержат в расширенных данных величину дистанции от начальной и конечной точки до предполагаемого реального конца или начала, как если бы не было разрыва. Поэтому полученные в списке точки я получил, добавивив эти данные, если они есть, к данным о конце/начале сегмента. Так что операцию сортировки нужно выполнять только по имеющемуся списку...

[VVA]

Tonic, Там есть алгоритм. Просто тебе нужно изменить способ получения координат. Вместо vlax-curve-getStartPoint взять точку из твоего списка.

[Tonic]

Да, что-то я невнимательно прочитал...
Но это огромная функция. Неужели нет способа сортировки средствами vl-sort? Я представляю, что нужно найти сегмент, не имеющий одной общей точки с другими (таких два - первый и последний), а потом от него сортировать в другую сторону: если у какого-то отрезка совпадает с ним точка, он будет вторым, у следующего совпадает точка со вторым - сделаем его третьим и т.д.
Что-то вроде (vl-sort lines_list (function (lambda (x1 x2) (equal (nth 1 x1) (nth 1 x2) 1)))) для приведённого выше списка. Ну, только эта строка не работает, конечно =)

P.S. Пока что самый короткий путь, который я придумал, выглядит так:
1. В цикле repeat поиск точки и соответствующего ей примитива, которая не свопадает ни с одной другой. Это будет начало или конец плеяды сегментов;
2. В цикле ищем последовательно точки, совпадающие с предыдущими точками примитива, и добавляем этот примитив следующим в список.

[Tonic]

VVA, есть ли другой путь, кроме исправление той функции?

[VVA]

Tonic, Есть. Написать свою функцию.

Код:

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

(defun ChainSelectFromAny2 ( lst fuzz / chain_list couple line_lst ln ss cycl line_list )
  ;;; lst - список вида
  ;;;((<Имя объекта: 7ef8a5b0> (-6684.89 14125.2 0.0) (-5621.34 13584.9 0.0))
 ;;;;(<Имя объекта: 7ef8a628> (-5621.34 13584.9 0.0) (-5204.81 12688.2 0.0)) ...)
 ;;; - fuzz точность (setq fuzz 0.1) 
(vl-load-com)
     (setq obj (car lst)
	   line_list (cdr lst)
	    chain_list (list obj)
	   cycl 0
	   )
    (foreach pt_Pattern (cdr obj)
     (while
        (setq couple
               (vl-remove-if-not
                 (function (lambda (x)
                             ;; значение допуска 0.01 можно изменить по ситуации
                             ;; в зависимости от единиц черчения : 
                             (or (equal (nth 1 x)
				        pt_Pattern
                                        fuzz      ;<--- допуск 
                                 ) ;_ end of equal
                                 (equal (nth 2 x)
                                        pt_Pattern
                                        fuzz     ;<--- допуск 
                                 ) ;_ end of equal
                             ) ;_ end of or
                           ) ;_ 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 (nth 1 ln) 1e-6)
                                (nth 2 ln)
                                (nth 1 ln)
                                )
                   )
           ) ;_ end of progn
         ) ;_ end of if
      )
   )
chain_list
)

Пример

Код:

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

(setq lst '(
	   ("Имя1" (-6684.89 14125.2 0.0) (-5621.34 13584.9 0.0))
	   ("Имя2" (-5621.34 13584.9 0.0) (-5204.81 12688.2 0.0))
	   ("Имя3" (-5788.34 13884.9 0.0) (-5204.81 12688.2 0.0))
	   ("Имя4" (-7621.34 12584.9 0.0) (-5788.34 13884.9 0.0))
	   )
      )
(ChainSelectFromAny2 lst 1e-3)

Вернет список, в котором или начало или конец совпадают

[Tonic]

Код:

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

(setq lst '(
("Имя1" (-4338.87 11536.2 0.0) (-3974.58 11643.9 0.0))
("Имя2" (-5621.34 13584.9 0.0) (-5204.81 12688.2 0.0))
("Имя3" (-3498.94 11905.2 0.0) (-3498.94 12773.5 0.0))
("Имя4" (-5204.81 12688.2 0.0) (-4895.25 12021.8 0.0))
("Имя5" (-6684.89 14125.2 0.0) (-5621.34 13584.9 0.0))
("Имя6" (-3974.58 11643.9 0.0) (-3498.94 11905.2 0.0))
("Имя7" (-4651.39 11496.8 0.0) (-4338.87 11536.2 0.0))
("Имя8" (-3498.94 12773.5 0.0) (-3498.94 13811.5 0.0))
("Имя9" (-4895.25 12021.8 0.0) (-4651.39 11496.8 0.0))
))

Результат:

Код:

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

(
("Имя8" (-3498.94 12773.5 0.0) (-3498.94 13811.5 0.0))
("Имя3" (-3498.94 11905.2 0.0) (-3498.94 12773.5 0.0))
("Имя6" (-3974.58 11643.9 0.0) (-3498.94 11905.2 0.0))
("Имя5" (-6684.89 14125.2 0.0) (-5621.34 13584.9 0.0))
("Имя2" (-5621.34 13584.9 0.0) (-5204.81 12688.2 0.0))
("Имя4" (-5204.81 12688.2 0.0) (-4895.25 12021.8 0.0))
("Имя9" (-4895.25 12021.8 0.0) (-4651.39 11496.8 0.0))
("Имя7" (-4651.39 11496.8 0.0) (-4338.87 11536.2 0.0))
("Имя1" (-4338.87 11536.2 0.0) (-3974.58 11643.9 0.0))
)

Жирным выделены уникальные точки (две крайние), которые принадлежат примитивам, не являющимися крайними в полученном списке! То есть, список не отсортирован по порядку от начала к концу или наоборот!

[VVA]

Можно попробывать так

Код:

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

(defun func ( lst fuzz / tmp far_point ret first_list i pat flag idx nn final_list)
  ;;; (func lst 0.1)
  (vl-load-com)
  (setq tmp (mip_MakeUniqueMembersOfListWithCount (apply 'append (mapcar 'cdr lst))))
  (setq first_list (mapcar 'cadr lst))
  (setq pat (vl-remove-if 'null
  (mapcar '(lambda(x)(if (and (= (cdr x) 1)
			      (apply 'or (mapcar '(lambda(y)(equal (car x) y 1e-3)) first_list))
			      )
			      (setq i (car x)))) tmp)
	      )
	)
  
 (foreach far_point pat
      (setq idx nil i '-1)
      (mapcar '(lambda(x)(setq i (1+ i))(if (equal far_point (nth 1 x) fuzz)(setq idx i))) lst)
      (setq ret (list(nth idx lst))
            tmp (remove-i idx lst))
      (while tmp
	(setq far_point (nth 2 (car ret)))
	(setq idx nil i '-1)
	(mapcar '(lambda(x)(setq i (1+ i))(if (equal far_point (nth 1 x)  fuzz)(setq idx i))) tmp)
	(if idx
	  (setq ret (cons (nth idx tmp) ret)
		tmp (remove-i idx tmp)
		)
	  (setq tmp nil)
	  )
	)
   (setq final_list (append final_list (list (reverse ret))))
   )
  final_list
  )



(defun mip_MakeUniqueMembersOfListWithCount  ( lst / OutList head countelt)
;; ===== mip_MakeUniqueMembersOfListWithCount =====
;;;Удаляет одинаковые (дубликаты) элементы из списка
;; с подсчетом числа вхождений
;; элемента
;;Применение
;;(mip_MakeUniqueMembersOfListWithCount '( 1 2 3 1 2 3 1 1 2 2))
;; Вернет ((1 . 4) (2 . 4) (3 . 2))
  
  (while lst
    (setq head (car lst)
	  countelt 0
          lst (vl-remove-if '(lambda(pt)(if (equal pt head 1e-6)(setq countelt (1+ countelt)) nil)) lst)
          OutList (append OutList (list (cons head countelt)))))
  OutList
  )

(defun remove-i (i lst)
  (setq i (1+ i))
  (vl-remove-if '(lambda(x) (zerop (setq i (1- i)))) lst)
)

Пример

Код:

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

(setq lst '(
("Имя1" (-4338.87 11536.2 0.0) (-3974.58 11643.9 0.0))
("Имя2" (-5621.34 13584.9 0.0) (-5204.81 12688.2 0.0))
("Имя3" (-3498.94 11905.2 0.0) (-3498.94 12773.5 0.0))
("Имя4" (-5204.81 12688.2 0.0) (-4895.25 12021.8 0.0))
("Имя5" (-6684.89 14125.2 0.0) (-5621.34 13584.9 0.0))
("Имя6" (-3974.58 11643.9 0.0) (-3498.94 11905.2 0.0))
("Имя7" (-4651.39 11496.8 0.0) (-4338.87 11536.2 0.0))
("Имя8" (-3498.94 12773.5 0.0) (-3498.94 13811.5 0.0))
("Имя9" (-4895.25 12021.8 0.0) (-4651.39 11496.8 0.0))
))
(func lst)

Итог

( ("Имя5" (-6684.89 14125.2 0.0) (-5621.34 13584.9 0.0)) ("Имя2" (-5621.34 13584.9 0.0) (-5204.81 12688.2 0.0)) ("Имя4" (-5204.81 12688.2 0.0) (-4895.25 12021.8 0.0)) ("Имя9" (-4895.25 12021.8 0.0) (-4651.39 11496.8 0.0)) ("Имя7" (-4651.39 11496.8 0.0) (-4338.87 11536.2 0.0)) ("Имя1" (-4338.87 11536.2 0.0) (-3974.58 11643.9 0.0)) ("Имя6" (-3974.58 11643.9 0.0) (-3498.94 11905.2 0.0)) ("Имя3" (-3498.94 11905.2 0.0) (-3498.94 12773.5 0.0)) ("Имя8" (-3498.94 12773.5 0.0) (-3498.94 13811.5 0.0)) )

[Tonic]

VVA, вложенный mapcar - это не так просто понять, а тем более написать =) В приведённой выше функции получается нужный список, но я попробовал список с реальными примитивами - и не получилось:

Код:

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

  (setq lst '(
	       ("Имя1" (-3498.94 12773.5 0.0) (-3498.94 13811.5 0.0))
	       ("Имя2" (-5204.81 12688.2 0.0) (-4895.25 12021.8 0.0))
	       ("Имя3" (-3498.94 11905.2 0.0) (-3498.94 12773.5 0.0))
	       ("Имя4" (-4338.87 11536.2 0.0) (-3974.58 11643.9 0.0))
	       ("Имя5" (-4651.39 11496.8 0.0) (-4338.87 11536.2 0.0))
	       ("Имя6" (-4895.25 12021.8 0.0) (-4651.39 11496.8 0.0))
	       ("Имя7" (-3974.58 11643.9 0.0) (-3498.94 11905.2 0.0))
	       ("Имя8" (-6684.89 14125.2 0.0) (-5621.34 13584.9 0.0))
	       ("Имя9" (-5621.34 13584.9 0.0) (-5204.81 12688.2 0.0))
  ))

Если же список будет представлять из себя нето подобное этому:

Код:

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

(<Имя объекта: 7ef85708> (-3498.94 12773.5 0.0) (-3498.94 13811.5 0.0))
(<Имя объекта: 7ef856c0> (-5204.81 12688.2 0.0) (-4895.25 12021.8 0.0))
(<Имя объекта: 7ef85700> (-3498.94 11905.2 0.0) (-3498.94 12773.5 0.0))

,
то функция нормально не срабатывает!

[VVA]

На твоем примере она срабатывает нормально. Имелось ввиду, что

Причём все эти отрезки и дуги достоверно представляют собой последовательно соединённые звенья, возможно, с небольшим допуском и У всех отрезков/дуг, кроме первого и последнего, имеются, конечно, общие точки

Т.есть есть ОДНА удаленная точка (не имеющая пару).
В своем примере таких 2

(<Имя объекта: 7ef85708> (-3498.94 12773.5 0.0) (-3498.94 13811.5 0.0)) (<Имя объекта: 7ef856c0> (-5204.81 12688.2 0.0) (-4895.25 12021.8 0.0)) (<Имя объекта: 7ef85700> (-3498.94 11905.2 0.0) (-3498.94 12773.5 0.0))

Немного исправил #9. Теперь будет возвращать список списков цепочек

[Tonic]

Нет-нет, я имел ввиду немного другое: приведённый список из 3 элементов должен был показать другое, а именно имена примитивов вместо строк "Имя1", "Имя2" и т.д. Т.е. пусть имеется последовательность отрезков/дуг; указывая точкой на один из сегментов, мы получаем итоговый список в виде ((<Имя объекта: aaaaaaaa> (x1 y1 z1) (x2 y2 z2)) ...), и в этом случает у меня функция не заработала - выдала список из 4 элементов (на самом деле в первоначальном списке их было 9!), а вот с искусственным случаем, когда вместо имени примитива стоит строка "имяN", всё работает на "ура".

[VVA]

Tonic, Если я скопирую твой список с форума, то получу как раз список из 4 элементов.

(<Имя объекта: 7ef85708> (-3498.94 12773.5 0.0) (-3498.94 13811.5 0.0)) (<Имя объекта: 7ef856c0> (-5204.81 12688.2 0.0) (-4895.25 12021.8 0.0)) (<Имя объекта: 7ef85700> (-3498.94 11905.2 0.0) (-3498.94 12773.5 0.0))

Поэтому тестовый список я сгенегировал так

Код:

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

(setq lst
       (list
	 (list (entlast)
	       '(-3498.94 12773.5 0.0)
	       '(-3498.94 13811.5 0.0)
	 )
	 (list (entlast)
	       '(-5204.81 12688.2 0.0)
	       '(-4895.25 12021.8 0.0)
	 )
	 (list (entlast)
	       '(-3498.94 11905.2 0.0)
	       '(-3498.94 12773.5 0.0)
	 )
       )
)

Итоговый список ты куда-то сохраняешь считываешь?

[Tonic]

VVA, спасибо за помощь! Кстати, я понял эту хитрую проблему - дело было в ошибке в строке:

Код:

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

(mapcar '(lambda(x)(setq i (1+ i))(if (equal far_point (nth 1 x))(setq idx i) fuzz)) tmp)

Правильный вариант:

Код:

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

(mapcar '(lambda(x)(setq i (1+ i))(if (equal far_point (nth 1 x) fuzz) (setq idx i))) tmp)

С тех пор всё безупречно! Ну, и ещё final_list лучше превратить в (car final_list), иначе окончательный список получится "заспискованным" =)