• Vazor
  • Восстановленный участник
  • На форуме с 16 сентября 2003г.
  • Сообщений: 47
  • Спасибо: 0

Тема: Сортировка списка точечных пар (Х возрастает, Y убывает)

Програмка сортирует все точечные пары текстовых элементов чертежа по возрастанию координаты Х.
Как переписать vl-sort так, чтобы в условии была проверка на убывание Y.
На входе: XY (10.0 32.0 0.0)(12.0 14.0 0.0) (10.0 60.0 0.0)
Должно быть на выходе: XY_Sorted (10.0 60.0 0.0) (10.0 32.0 0.0)(12.0 14.0 0.0)

(defun C:test ()
(vl-load-com)
  ;*** создает набор из всех текстовых элементов чертежа
  (setq All (ssget "_x" '((0 . "TEXT"))))                    
  (setq L (sslength all))              (setq XY nil)
  (setq i 0)
  ;*** создает список из точечных пар элементов
  (while (< i l)
    (progn
      (setq XY (cons (cdr (assoc 10 (entget (ssname all  i)))) XY))        
      (setq i (1+ i))
    );end of progn
  );end of while
  ;*** сортирует список из точечных пар по возрастанию координаты Х
  (setq XY_Sorted (vl-sort XY (function (lambda (e1 e2) (< (car e1) (car e2))))))
)

  • На форуме с 23 апреля 2003г.
  • Сообщений: 795
  • Спасибо: 0

Re: Сортировка списка точечных пар (Х возрастает, Y убывает)

(setq xy2 (vl-sort xy
'(lambda (x1 x2)
 (> (cadr x1)(cadr x2))
)
)
)

  • Vazor
  • Восстановленный участник
  • На форуме с 16 сентября 2003г.
  • Сообщений: 47
  • Спасибо: 0

Re: Сортировка списка точечных пар (Х возрастает, Y убывает)

> Эдуард
Ваш код делает сортировку только по уменьшению коорди наты Y, и не сортирует по возрастанию координату Х.

  • На форуме с 23 апреля 2003г.
  • Сообщений: 795
  • Спасибо: 0

Re: Сортировка списка точечных пар (Х возрастает, Y убывает)

> Vazor
'(10 10) '(11 11) - попробуйте отсортировать эти два списка
по возростанию x  и убыванию y

  • Vazor
  • Восстановленный участник
  • На форуме с 16 сентября 2003г.
  • Сообщений: 47
  • Спасибо: 0

Re: Сортировка списка точечных пар (Х возрастает, Y убывает)

Начальный список должен быть такой:
(10.0 32.0 0.0)(12.0 14.0 0.0) (10.0 60.0 0.0)

'(10 10) '(11 11)

Данный случай не имеет смысла, потому что условие задачи нужно только для того случая, когда у двух точек координаты X одинаковые, Y разные.

  • Vazor
  • Восстановленный участник
  • На форуме с 16 сентября 2003г.
  • Сообщений: 47
  • Спасибо: 0

Re: Сортировка списка точечных пар (Х возрастает, Y убывает)

Должно быть нечто вроде этого:

(vl-sort XY (function (lambda (e1 e2) (< (car e1) (car e2)) and (> (cadr e1) (cadr e2))))))

  • BelPolk
  • Восстановленный участник
  • На форуме с 28 августа 2002г.
  • Сообщений: 63
  • Спасибо: 0

Re: Сортировка списка точечных пар (Х возрастает, Y убывает)

(vl-sort XY (function (lambda (e1 e2) (and (< (car e1) (car e2)) (> (cadr e1) (cadr e2))))))

  • Vazor
  • Восстановленный участник
  • На форуме с 16 сентября 2003г.
  • Сообщений: 47
  • Спасибо: 0

Re: Сортировка списка точечных пар (Х возрастает, Y убывает)

> BelPolk

 (setq X_Sorted (vl-sort XY (function (lambda (e1 e2) (< (car e1) (car e2))))))
  (setq Y_Sorted (vl-sort X_Sorted (function (lambda (e1 e2) (and (equal (car e1) (car e2)) (> (cadr e1) (cadr e2)))))))

Спасибо за идею, совсем забыл что (a + b) --> (+ a b)  ?:^)

  • AVD
  • Восстановленный участник
  • На форуме с 4 августа 2003г.
  • Сообщений: 37
  • Спасибо: 0

Re: Сортировка списка точечных пар (Х возрастает, Y убывает)

Функцию писал давно, поэтому возможно в ней есть некрасивости. Исправлять лень, работает и ладно.

;;;  (sort_nab_xy <набор> <k>)
;;;  Сортирует примитивы в наборе, который передаётся в качестве
;;;  аргумента, по уменьшению координаты Y или
;;;  по увеличению Х (зависит от аргумента k)
;;;  При K=1 идет сортировка по Х, при K=2 по Y.
;;;  Аргумент <набор> - набор в котором нужно сортировать примитивы.
;;;  Если применить эту функцию к одному набору два раза, сначала при K=1,
;;;  затем при k=2 то набор будет отсортирован "слева направо, сверху вниз".
;;;  Возвращает набор.
(defun sort_nab_xy
           (nabor   k        /        CRD        CT        CT1
            ENTNAME LENNABOR        LENSP   NAME    NEW_NABOR
            SP
           )
  (setq ct 0)
  (repeat (sslength nabor)
    (setq entname (entget (ssname nabor ct)))
    (setq crd (nth k (assoc 10 entname)))
    (setq sp (append sp (list crd)))
    (setq ct (1+ ct))
  ) ;_ end of repeat
;;;  Сортировка списка
  (if (= k 1)
    (setq sp (vl-sort sp '<))
    (setq sp (vl-sort sp '>))
  ) ;_ end of if
  (setq    ct      0
    lensp      (length sp)
    lennabor  (sslength nabor)
    new_nabor (ssadd)
  ) ;_ end of setq
  (repeat lensp
    (setq crd (nth ct sp))
    (setq ct1 0)
    (repeat lennabor
      (setq name (ssname nabor ct1))
      (setq entname (entget name))
      (if (equal (nth k (assoc 10 entname)) crd)
    (ssadd name new_nabor)
      ) ;_ end of if
      (setq ct1 (1+ ct1))
    ) ;_ end of repeat
    (setq ct (1+ ct))
  ) ;_ end of repeat
  new_nabor
) ;_ конец defun