[LISP] multi-level sorting

[Assgarth]

Hi,

 

I have functions:

(defun zk:LST_SS->List (sel / % l)
(repeat 
	(setq % (sslength sel))
	(setq % (1- %) 
		  l (cons (ssname sel %) l)
	)
)
)

 

(defun zk:SortLstXYEnt->Lst (lstEnt mode / lstPkt lstMode lstOut lstSgn)

(cond 
	((= mode "-Y(X)")  (setq lstMode (list cadadr caadr) lstSgn (list > <)))
	((= mode "-Y(-X)") (setq lstMode (list cadadr caadr) lstSgn (list > >)))
	((= mode "Y(X)")   (setq lstMode (list cadadr caadr) lstSgn (list < <)))
	((= mode "Y(-X)")  (setq lstMode (list cadadr caadr) lstSgn (list < >)))
	((= mode "X(Y)")   (setq lstMode (list caadr cadadr) lstSgn (list < <)))
	((= mode "X(-Y)")  (setq lstMode (list caadr cadadr) lstSgn (list < >)))
	((= mode "-X(Y)")  (setq lstMode (list caadr cadadr) lstSgn (list > <)))
	((= mode "-X(-Y)") (setq lstMode (list caadr cadadr) lstSgn (list > >)))
)

(foreach ent lstEnt (setq lstPkt (cons (cons ent (list (cdr(assoc 10 (entget ent))))) lstPkt)))			
(setq lstPkt (zk:SortFunction lstPkt > lstMode))

)

 

;;---------------------------------=={ zk:SortFunction }==---------------------------------;;
;; multi-level sorting                                                         ;;
;;-----------------------------------------------------------------------------------------;;
;; Lst [LST]  - list np. ((<entity name> '(10 20 0)) (<entity name> '(20 30 0)))...       ;;
;; Sgn [+/-]  - sort direction indicator                                               ;;
;; Col [LST]  - list of columns, after which they followed another sort                ;;
;;-----------------------------------------------------------------------------------------;;
;; ex. Col: (list caadr cadadr)                                                            ;;
;;-----------------------------------------------------------------------------------------;;
(defun zk:SortFunction (Lst Sgn Col)
(member Sgn (list < >))
(mapcar
	'(lambda (%)
		(setq Lst
			(vl-sort Lst
				(function
					(lambda (e1 e2)
						(Sgn
							((eval %) e1)
							((eval %) e2)
						)
					) 
				)
			)
		)
	)
	Col
)
Lst
)

 

Run:

(setq ssGroup (ssget (list (cons 0 "TEXT"))))
(zk:LST_SS->List ssGroup)

 

and now I want to change the "zk:SortFunction", so that sorting takes place according to the list ex:

(setq lstSgn (list > >))

In attach are all combinations. Now I have only 4 from 8th; sign ">" or "

 

Is someone able to help me?

greet

sort.dwg

[irneb]

There're a few things in your code which is strange, e.g. your sort function only returns the last item in the list - or at least that's how I understand it.

 

Anyhow, the drawing you've attached has the sample texts ever so slightly off. E.g. the first group (-Y+X) has Y insertion values for "1" as 3368.7494, but the "3" on the "same" line has a Y of 3368.7503. Thus the "3" will be sorted in front of the "1" since it's "higher" - even just by 0.0009.

 

For that reason I'm proposing adding a fuzz factor:

(defun sort-XY (entLst order fuzz / func as-c fc comp)
 (defun as-c (n item) (nth n (assoc 10 (entget item))))
 (defun fc (opp v1 v2 / ) (opp (fix (/ v1 fuzz)) (fix (/ v2 fuzz))))
 (defun comp (opp n pt1 pt2) (fc opp (as-c n pt1) (as-c n pt2)))
 (setq func (cond
              ((= order 'XY) '(lambda (a b) (or (comp < 2 a b) (comp < 1 a b))))
              ((= order 'X-Y) '(lambda (a b) (or (comp > 2 a b) (comp < 1 a b))))
              ((= order '-XY) '(lambda (a b) (or (comp < 2 a b) (comp > 1 a b))))
              ((= order '-X-Y) '(lambda (a b) (or (comp > 2 a b) (comp > 1 a b))))
              ((= order 'YX) '(lambda (a b) (or (comp < 1 a b) (comp < 2 a b))))
              ((= order 'Y-X) '(lambda (a b) (or (comp > 1 a b) (comp < 2 a b))))
              ((= order '-YX) '(lambda (a b) (or (comp < 1 a b) (comp > 2 a b))))
              ((= order '-Y-X) '(lambda (a b) (or (comp > 1 a b) (comp > 2 a b))))
              (t '(lambda (a b) t))
            )
 )
 (vl-sort entLst func)
)

Note, this function could probably be made a lot simpler and/or efficient. But it shows the general idea. Here's the code I've used to test it:

(defun c:TestXYSort (/ ss order fuzz lst)
 (if (and (setq ss (ssget (list (cons 0 "TEXT"))))
          (progn
            (initget "XY X-Y -XY -X-Y YX Y-X -YX -Y-X")
            (setq order (getkword "Select order [XY/X-Y/-XY/-X-Y/YX/Y-X/-YX/-Y-X]: "))
          )
          (or (setq fuzz (getreal "Fuzz factor <1.0>: "))
              (setq fuzz 1.)
          )
     )
   (progn
     (setq lst (zk:LST_SS->List ss))
     (setq lst (sort-XY lst (read order) fuzz))
     (prin1 (mapcar '(lambda (item) (cdr (assoc 1 (entget item)))) lst))
   )
 )
 (princ)
)

[Assgarth]

Hi irneb,

 

thank you for your help and an example

I checked it, and I found two errors (look at dwg.file - red color "NO OKEY").

 

greet

Drawing4.dwg

[irneb]

OK, second try. I've used a more literal comparison, rather than rely on or. Made the comp's arguments more inline with the order - a bit more readable. And changed to using car and cdr instead of nth. Also made efficiency a bit better by moving the entget outside the sort comparison and using an index sorted list to retrieve from the original. Also consolidated all those internal defuns into one:

(defun sort-XY (entLst order fuzz / lst func comp)
 (setq lst (mapcar '(lambda (ename) (cdr (assoc 10 (entget ename)))) entLst))
 (defun comp (opr1 item1 opr2 item2)
   (if (equal (item2 a) (item2 b) fuzz)
     (opr1 (item1 a) (item1 b))
     (opr2 (item2 a) (item2 b))
   )
 )
 (setq func (cond
              ((= order 'XY) '(lambda (a b) (comp < car < cadr)))
              ((= order 'X-Y) '(lambda (a b) (comp < car > cadr)))
              ((= order '-XY) '(lambda (a b) (comp > car < cadr)))
              ((= order '-X-Y) '(lambda (a b) (comp > car > cadr)))
              ((= order 'YX) '(lambda (a b) (comp < cadr < car)))
              ((= order 'Y-X) '(lambda (a b) (comp < cadr > car)))
              ((= order '-YX) '(lambda (a b) (comp > cadr < car)))
              ((= order '-Y-X) '(lambda (a b) (comp > cadr > car)))
              (t '(lambda (a b) t))
            )
 )
 (mapcar '(lambda (idx) (nth idx entLst)) (vl-sort-i lst func))
)

I've also noted that there's some items in your original sort.dwg where the x/y is off by more than 1.0. So I've updated my test function to use a fuzz distance of 10.0 instead. Also added a test to see if the sort was correct as per the text value.

(defun c:TestXYSort (/ ss order fuzz lst)
 (if (and (setq ss (ssget (list (cons 0 "TEXT"))))
          (progn
            (initget "XY X-Y -XY -X-Y YX Y-X -YX -Y-X")
            (setq order (getkword "Select order [XY/X-Y/-XY/-X-Y/YX/Y-X/-YX/-Y-X]: "))
          )
          (or (setq fuzz (getreal "Fuzz factor <10.0>: "))
              (setq fuzz 10.)
          )
     )
   (progn
     (setq lst (zk:LST_SS->List ss))
     (setq lst (sort-XY lst (read order) fuzz))
     (prin1 (setq lst (mapcar '(lambda (item) (cdr (assoc 1 (entget item)))) lst)))
     (if (vl-every 'eq lst (acad_strlsort lst))
       (princ "\nSorted correctly.")
       (princ "\nThere's an error.")
     )
   )
 )
 (princ)
)