Selection Set Sorting base on X axis

[Anonymous]

Hi Sirs,

I'm just new on using autolisp and still learning so please help me on the dilemma i'm facing.

Basically i want to sort a selection set of polyline (rectangle) under the layer of "REF" basing on it's X axis. I copied bits of info around the net but i can't get it work the way i want it to.

Here is where i copied some of it.
[URL="http://forums.augi.com/showthread.php?137837-Sort-Selectionset-by-X-coord"]http://forums.augi.com/sh...]

(setq plt_set (ssget '((8 . "A3 REF")))) ;select layer "a3 ref"
  (setq i (getint "\nEnter page no.: ") ;input page number
	count 1
	count1 (sslength plt_set)
	ss6 (ssadd)
	ss4 (list (ssname plt_set (1- count)))
	)

  (while (<= (1+ count) count1)        ;SORT LIST BY X COORD LOW TO HIGH
    (setq ss3 (list (ssname plt_set count)))
    (setq ss4 (append ss4 ss3))
    (setq count (1+ count))
  ) ;_ end of while
  
  (vl-sort ss4
	 (function
	   (lambda (a b) (> ;; or maybe > depending on the order you want
			   (cadr (assoc 10 (entget a)))
			   (cadr (assoc 10 (entget b)))
			   )
	     )
	   )
	 )
  (foreach ss5 (reverse ss4)
    (setq ss6 (ssadd ss5 ss6))
    )

It is still sorting by the sequence of when it was created.

Hoping for your kind help Cad Masters.

Thank you,
Ryan

[ВeekeeCZ]

Hi Ryan and welcome to the Forums!

It's hard for me to get the logic of your variables naming. I've took a liberty and took another code from the link you've posted - @alanjt_ 's code look much better and I've fixed the minor typo it had.

(defun c:Test ( / _SortSSByXValue ss)
  
  ; alanjt
  ; http://forums.augi.com/showthread.php?137837-Sort-Selectionset-by-X-coord%22]http://forums.augi.com/showthread.php?137837-Sort-Selectionset-by-X-coord[/URL
  (defun _SortSSByXValue (ss / lst i e add)
    (if (eq (type ss) 'PICKSET)
      (progn
        (repeat (setq i (sslength ss))
          (setq lst (cons (cons (setq e (ssname ss (setq i (1- i))))
                                (cadr (assoc 10 (entget e))))
                          lst)))
        (setq add (ssadd))
        (foreach e (vl-sort lst (function (lambda (a b) (< (cdr a) (cdr b)))))
          (ssadd (car e) add))
        (if (> (sslength add) 0)
          add))))
  
  ; -----------------------------------------------------------
  
  (if (setq ss (ssget '((0 . "LWPOLYLINE") (8 . "A3 REF"))))
    (setq ss (_SortSSByXValue ss))))

BUT be aware that a rectangle is by a definition a LWPOLYLINE which EACH vertex has code 10 - so the code is sorting the ss by the FIRST vertex of each polyline (rectangle).

[Anonymous]

I got my code working as i would like. the vl-sort part is the problem, i didnt store it in a new variable so. " (setq ss99 (vl-sort ...)" this solves the prob.

thank you for your response. 

[john.uhden]

But be careful.  Are you sure they are lightweights?  Is the first vertex always to the left?

Shooting from the hip (as they say in the old western movies, before Clint Eastwood)... IOW, not tested at all.

(defun @group (old n / item new)
  (while old
    (while (< (length item) n)
      (setq item (cons (car old) item) old (cdr old))
    )
    (setq new (cons (reverse item) new) item nil)
  )
  (reverse new)
)
(defun @SortPolyLR ( / ss i n obj coords objlist)
  (and
    (setq ss (ssget '((0 . *POLYLINE"))))
    (repeat (setq i (sslength ss))
      (setq obj (vlax-ename->vla-object (ssname (setq i (1- i)))))
      (setq coords (vlax-get Obj 'Coordinates))
      (setq n (if (= (vlax-get Obj 'ObjectName) "AcDbPolyline") 2 3))
      (setq coords (@group coords n))
      (setq objlist (cons (cons (apply 'min (mapcar 'car coords)) obj) objlist))
    )
    (setq objlist (vl-sort '(lambda (a b)(< (car a)(car b))) objlist))
  )
  (mapcar 'cdr objlist)
)

@SortPolyLR should return a list of selected polyline objects (LW, heavy, or 3D) sorted in ascending X value from their left-most vertex.

No, it does not account for bulges out to the left, but could be written to use getboundingbox instead.

I am also pleased that it is the first use of the new function @group, unless someone has just beaten me to it.

[john.uhden]

Oops.  I just saw where I forgot a quote before *POLYLINE.  We old farts are so forgetful.  @Booker280Z would not make such a mistake.

Wish me luck tomorrow.  I'm off to flatter NJDEP into accepting my methodology for a flood plain analysis.  I feel confident as it uses my own1993 software. :]

[john.uhden]

Yes, I also forgot (in red)...

(setq obj (vlax-ename->vla-object (ssname ss (setq i (1- i)))))

[Ranjit_Singh]

Yet another possibility

(defun c:somefunc  (/)
 (setq ss1 (ssadd))
 (mapcar '(lambda (x) (ssadd (car x) ss1))
         (vl-sort (mapcar '(lambda (x)
                            (cons x
                                  (vl-sort (cdr (reverse (vl-remove-if-not 'listp (mapcar 'cdr (entget x)))))
                                           '(lambda (x y) (< (cadr x) (cadr y))))))
                          (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "lwpolyline") (8 . "REF")))))))
                  '(lambda (x y) (< (cadadr x) (cadadr y)))))
 ss1)

[lando7189]

Here is my little utility i use for sorting selection sets.  The reason for some of the alternative features is to being able to call it from VBA (in which case, i later on developed my own sort function within VBA to reduce LISP call from within VBA code).

; ssSort
;           ss:  AutoLISP pickset, or a selection set name -- if nil, it uses the previous selection set
;          xyz: 'X 'Y 'Z (or "x" "y" "z"... or 0 1 2)
;          dir:  +1 to +2 ascending, -1 to -2 descending... where pos/neg 1 is min and 2 is max (1.5 mid)
; RETURN VALUE: the sorted pickset
;
; examples:  (ssSort mySelSet 'X 1.5)  -- sorts selection set 'mySelSet' by center X ascending
;            (ssSort nil 'Y -1)        -- sorts the previous selection set by minimum Y descending

(defun ssSort (ss xyz dir /  
                RetVal objSelSet i ent obj entMin entMax c valMin valMax val presort sorted objs item)
  (setq RetVal nil)
  (if (not ss)
    (setq ss (ssget "P"))
  )
  (if (= (type ss) 'STR)
    (if (vl-Catch-All-Error-p (setq objSelSet (vl-Catch-All-Apply 'vla-item (list (vla-get-SelectionSets (vla-get-ActiveDocument (vlax-get-acad-object))) ss))))
      (progn
        (princ (strcat "\nUnable to find selection set '" ss "."))
      )
      (progn
        (setq ss (ssadd))
        (vlax-for obj objSelSet
          (setq ss (ssadd (vlax-vla-object->ename obj) ss))
        )
      )
    )
  )
    
  (cond
   ((or (= xyz 0) (= xyz 'X) (= xyz "X") (= xyz "x")) (setq c 0))
   ((or (= xyz 1) (= xyz 'Y) (= xyz "Y") (= xyz "y")) (setq c 1))
   ((or (= xyz 2) (= xyz 'Z) (= xyz "Z") (= xyz "z")) (setq c 2))
  )
    
  (if (and ss (= (type ss) 'PICKSET) (>= (abs dir) 1) (<= (abs dir) 2))
    (progn
      (setq i -1)
      (repeat (sslength ss)
        (setq ent (ssname ss (setq i (1+ i)))
              obj (vlax-ename->vla-object ent)
        )
        (vla-getBoundingBox obj 'entMin 'entmax)
        (if (and entMin entMax)
          (setq valMin (vlax-safearray-get-element entMin c)
                valMax (vlax-safearray-get-element entMax c)
                val (+ valMin (* (- valMax valMin) (- (abs dir) 1)))
                presort (cons (cons ent val) presort)
          )
        )
      )
      (if presort
        (progn
          (setq sorted (vl-sort presort (function (lambda (e1 e2) (< (cdr (if (> dir 0) e1 e2)) (cdr (if (> dir 0) e2 e1)))))))
          (setq i 0)
          (setq Retval (ssadd))
          (foreach item sorted
            (setq RetVal (ssadd (car item) RetVal))
          )
          (if objSelSet
            (progn
              (vla-Clear objSelSet)
              (setq objs (vlax-make-safearray vlax-vbObject (cons 0 (- (sslength ss) 1)))
                    i -1
              )
              (foreach item sorted
                (vlax-safearray-put-element objs (setq i (1+ i)) (vlax-ename->vla-object (car item)))
              )
              (vla-AddItems objSelSet objs)
            )   
          )   
        )
      )
    )
  )
  RetVal
)