problem with vl sort

[lozanoma]

Hello, everyone
I have this code that has already ordered my list by the y coordinate, but I need to group them in columns with a predetermined number, and with this code I group them all, I attach two drawings, previous and what I need, thank you very much to all

 

 

code:

 

(defun _SortSSByXValdcha ( /);

  (setq BlkGroup newss)
  (if (eq (type BlkGroup) 'PICKSET)
    (progn
      (repeat (setq i (sslength BlkGroup))
        (setq lst1 (cons (cons (setq e (ssname BlkGroup (setq i (1- i))))
                              (cdr (assoc 10 (entget e)))
                        )
                        lst1
                  )
        )
      )
      (setq add (ssadd))
      (foreach e (vl-sort lst1 (function (lambda (a b)
                                 (cond
                   ((> (cadr a) (cadr b)))
                               ((= (cadr a) (cadr b))  (> (caddr  a) (caddr  b)))
                     
                     )
                     )
                     )
                     )
                                      
                     (ssadd (car e) add));
      (if (> (sslength add) 0)
        add
      )
    )
  )
);end defun

finally.dwg previous.dwg

[rlx]

(defun c:t1 ( / ss el c r a l ip noc)
  (if (and (setq ss (ssget))(setq el (ss->lst ss))(setq c (getint "\nNo. groups horizontally (i.e. 4) : "))
           (setq r (getint "\nNo. groups vertically (i.e. 2)   : ")))
    (progn
      (foreach e el
        (if (not (setq a (assoc (car (setq ip (getIP e))) l)))
          (setq l (cons (cons (car ip) (list (cons (cadr ip) e))) l))
          (setq l (subst (cons (car a) (cons (cons (cadr ip) e) (cdr a))) a l))))
      (setq l (vl-sort l (function (lambda (a b) (< (car a) (car b))))) noc (fix (/ (length l) c)))
      (setq l (mapcar (function (lambda (c) (mapcar 'cdr (vl-sort (cdr c) (function (lambda (a b)(> (car a)(car b)))))))) l))
      (setq l (split_list l noc))
      (foreach sub l
        (foreach g (split_list (setq sub (apply 'mapcar (cons 'list sub))) (fix (/ (length sub) r)))
          (vlax-invoke (vla-add (vla-get-groups (vla-get-activedocument (vlax-get-acad-object))) "*")
               'appenditems (mapcar 'vlax-ename->vla-object (apply 'append g)))))
    )
  )
  (princ)
)
(defun split_list (l n / _sub) (defun _sub (a b c / r) (if (not (<= 1 c (- (length a) b)))(setq c (- (length a) (1- b))))
  (repeat c (setq r (cons (nth (1- b) a) r) b (1+ b)))(reverse r))(if l (cons (_sub l 1 n) (split_list (_sub l (1+ n) nil) n))))
(defun ss->lst (ss / i l)(setq i 0)(repeat (sslength ss)(setq l (cons (ssname ss i) l) i (1+ i))) l)
(defun getIP (e / d)(if (and (= 'ename (type e))(setq d (entget e))(setq d (assoc 10 d))) (cdr d)))

[lozanoma]

18 hours ago, rlx said:

 

(defun c:t1 ( / ss el c r a l ip noc)
  (if (and (setq ss (ssget))(setq el (ss->lst ss))(setq c (getint "\nNo. groups horizontally (i.e. 4) : "))
           (setq r (getint "\nNo. groups vertically (i.e. 2)   : ")))
    (progn
      (foreach e el
        (if (not (setq a (assoc (car (setq ip (getIP e))) l)))
          (setq l (cons (cons (car ip) (list (cons (cadr ip) e))) l))
          (setq l (subst (cons (car a) (cons (cons (cadr ip) e) (cdr a))) a l))))
      (setq l (vl-sort l (function (lambda (a b) (< (car a) (car b))))) noc (fix (/ (length l) c)))
      (setq l (mapcar (function (lambda (c) (mapcar 'cdr (vl-sort (cdr c) (function (lambda (a b)(> (car a)(car b)))))))) l))
      (setq l (split_list l noc))
      (foreach sub l
        (foreach g (split_list (setq sub (apply 'mapcar (cons 'list sub))) (fix (/ (length sub) r)))
          (vlax-invoke (vla-add (vla-get-groups (vla-get-activedocument (vlax-get-acad-object))) "*")
               'appenditems (mapcar 'vlax-ename->vla-object (apply 'append g)))))
    )
  )
  (princ)
)
(defun split_list (l n / _sub) (defun _sub (a b c / r) (if (not (<= 1 c (- (length a) b)))(setq c (- (length a) (1- b))))
  (repeat c (setq r (cons (nth (1- b) a) r) b (1+ b)))(reverse r))(if l (cons (_sub l 1 n) (split_list (_sub l (1+ n) nil) n))))
(defun ss->lst (ss / i l)(setq i 0)(repeat (sslength ss)(setq l (cons (ssname ss i) l) i (1+ i))) l)
(defun getIP (e / d)(if (and (= 'ename (type e))(setq d (entget e))(setq d (assoc 10 d))) (cdr d)))