[swkx]

Коллеги, вопрос для пятницы)):
Имеем 4 списка, в каждом набор точек:
lst1 = ((x y) (x y) (x y) ...)
lst2 = ((x y) (x y) (x y) ...)
lst3 = ((x y) (x y) (x y) ...)
lst4 = ((x y) (x y) (x y) ...)

Нужно получить список lstres всех возможных прямоугольников
lstres = (
((x1 y2) (x2 y2) (x3 y3) (x4 y4)) - 1-й прямоугольник
....
((xn yn) (xn yn) (xn yn) (xn yn)) - n-й прямоугольник
)

Иллюстрация на картинке. Предложите красивое решение.
Все точки двумерные, в каждом списке несколько сотен точек.

[Дима_]

Я кажется задачу не понял -

((x1 y2) (x2 y2) (x3 y3) (x4 y4))

точно y2?

Нужно получить список lstres всех возможных прямоугольников

всех возможных - или по одиноковому индексу - если по одинаковому индексу то все просто:

Код:

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

 (mapcar 'list lst1 lst2 lst3 lst4)

[swkx]

Всех возможных.

[Disney]

Вроде работает, но хотел бы посмотреть на какую-нибудь рекурсию от Димы

Код:

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

 (defun c:test  (/ list1 list2 list3 list4 lstres get_point)
  (defun get_point  (msg)
    (princ msg)
    (mapcar (function (lambda (x) (cdr (assoc 10 (entget x)))))
	    (vl-remove-if-not '(lambda (x) (= (type x) 'ENAME))
			      (mapcar 'cadr (ssnamex (ssget "_:L" '((0 . "POINT"))))))))
  (setq	list1 (get_point "\nПервый список")
	list2 (get_point "\nВторой список")
	list3 (get_point "\nТретий список")
	list4 (get_point "\nЧетвёртый список"))
  (if (setq lstres (search_rectangle list1 list2 list3 list4))
    (mapcar (function
	      (lambda (x)
		(entmakex
		  (append (list	(cons 0 "LWPOLYLINE")
				(cons 100 "AcDbEntity")
				(cons 100 "AcDbPolyline")
				(cons 90 (length x))
				(cons 70 1)
				(cons 210 (trans '(0 0 1) 1 0)))
			  (mapcar (function (lambda (p) (cons 10 p))) x)))))
	    lstres)))
;;;

(defun search_rectangle	 (list1 list2 list3 list4 / lstres midl_point)
  (defun midl_point  (_list / leng)
    (setq leng (length _list))
    (list (/ (apply '+ (mapcar 'car _list)) leng)
	  (/ (apply '+ (mapcar 'cadr _list)) leng)))
  (setq	all_list      (list list1 list2 list3 list4)
	list_of_centr (mapcar (function midl_point) all_list)
	list_summ     (mapcar (function (lambda (x) (+ (car x) (cadr x)))) list_of_centr)
	bottom_left   (nth (vl-position (apply 'min list_summ) list_summ) all_list)
	top_right     (nth (vl-position (apply 'max list_summ) list_summ) all_list)
	list_min      (mapcar (function (lambda (x) (- (car x) (cadr x)))) list_of_centr)
	top_left      (nth (vl-position (apply 'min list_min) list_min) all_list)
	bottom_right  (nth (vl-position (apply 'max list_min) list_min) all_list))
  (while bottom_left
    (setq t1	      (car bottom_left)
	  bottom_left (cdr bottom_left))
    (if	(setq t2 (car (vl-remove-if-not	'(lambda (x) (eq (car x) (car t1))) top_left)))
      (if (setq	t3 (car (vl-remove-if-not '(lambda (x) (eq (cadr x) (cadr t2))) top_right)))
	(if (setq t4 (car (vl-remove-if-not '(lambda (x) (eq (car x) (car t3))) bottom_right)))
	  (setq lstres (cons (list t1 t2 t3 t4) lstres))))))
  lstres)

[swkx]

Disney,
если не трудно, опиши в двух словах суть метода.
По коду не могу сообразить(

Собственно, мне готовое решение и не нужно, просто хотелось услышать различные подходы.

Лично я тупо перебираю все точки из lst1, для каждой определяю наличие точек с такой же коорд. X в lst2 и такой же коорд. Y в lst4 и при наличии таковых смотрю, есть ли подходящая точка в lst3.
Работает, конечно, но организм просит какого-то оригинального решения.

[Disney]

Сообщение от swkx Лично я тупо перебираю все точки из lst1, для каждой определяю наличие точек с такой же коорд. X в lst2 и такой же коорд. Y в lst4 и при наличии таковых смотрю, есть ли подходящая точка в lst3.

я делал точно так же вот эта часть кода

Код:

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

  (while bottom_left
    (setq t1	      (car bottom_left)
	  bottom_left (cdr bottom_left)
	  ) ;_ _end_ofsetq
    (if	(setq t2 (car (vl-remove-if-not	'(lambda (x) (eq (car x) (car t1)))
					top_left
					) ;_ _end_ofvl-remove-if-not
		      ) ;_ _end_ofcar
	      ) ;_ _end_ofsetq
      (if (setq	t3 (car	(vl-remove-if-not '(lambda (x) (eq (cadr x) (cadr t2)))
					  top_right
					  ) ;_ _end_ofvl-remove-if-not
			) ;_ _end_ofcar
		) ;_ _end_ofsetq
	(if (setq t4 (car (vl-remove-if-not '(lambda (x) (eq (car x) (car t3)))
					    bottom_right
					    ) ;_ _end_ofvl-remove-if-not
			  ) ;_ _end_ofcar
		  ) ;_ _end_ofsetq
	  (setq lstres (cons (list t1 t2 t3 t4) lstres))
	  ) ;_ _end_ofif
	) ;_ _end_ofif
      ) ;_ _end_ofif
    ) ;_ _end_ofwhile

А в этой части, я разбирал, где какой список: bottom_left - нижний левый, top_right - верхний правый, top_left - верхний левый, bottom_right - нижний правый, потому что я предположил, что нумерация списков произвольная, и не факт, что следующий раз у тебя Lst2 не окажется с право в низу.

Код:

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

  (setq	all_list      (list list1 list2 list3 list4)
	list_of_centr (mapcar (function midl_point) all_list)
	list_summ     (mapcar (function (lambda (x) (+ (car x) (cadr x))))
			      list_of_centr
			      ) ;_ _end_ofmapcar
	bottom_left   (nth (vl-position (apply 'min list_summ) list_summ)
			   all_list
			   ) ;_ _end_ofnth
	top_right     (nth (vl-position (apply 'max list_summ) list_summ)
			   all_list
			   ) ;_ _end_ofnth
	list_min      (mapcar (function (lambda (x) (- (car x) (cadr x))))
			      list_of_centr
			      ) ;_ _end_ofmapcar
	top_left      (nth (vl-position (apply 'min list_min) list_min) all_list)
	bottom_right  (nth (vl-position (apply 'max list_min) list_min) all_list)
	) ;_ _end_ofsetq

[swkx]

Теперь понял, спасибо)