Program to sort objects in a list numerically

[ccowgill]

(defun sort (lst)
(vl-sort lst '(lambda (e1 e2) (< (car e1) (car e2))))
) ;_ end of defun


as far as I know, the above program is supposed to sort a list numerically, the problem I have is, it sorts it 1,10,100,1000,1001,1002...2,20,200,2000,20001...
can someone take a look at it and possibly offer some suggestion

Thanks

[irneb]

Where do you obtain the values of the list? The order you show seems as if the values are string values. This is the 2 scenarios I get when running in AutoCAD:

Command: (setq lst '((1004 . 5) (6 . 2) (204 . 8) (10 . 0)))
((1004 . 5) (6 . 2) (204 . 8) (10 . 0))

Command: (vl-sort lst '(lambda (e1 e2) (< (car e1) (car e2))))

((6 . 2) (10 . 0) (204 . 8) (1004 . 5))

Command: (setq lst '(("1004" . 5) ("6" . 2) ("204" . 8) ("10" . 0)))
(("1004" . 5) ("6" . 2) ("204" . 8) ("10" . 0))

Command: (vl-sort lst '(lambda (e1 e2) (< (car e1) (car e2))))

(("10" . 0) ("1004" . 5) ("204" . 8) ("6" . 2))

[CAB2k]

Sounds like strings to me too.

_$ (vl-sort '(3 2 111 3) '<)
(2 3 111)
_$ (vl-sort '("3" "2" "111" "3") '<)
("111" "2" "3" "3")
_$ (vl-sort (mapcar 'read '("3" "2" "111" "3")) '<)
(2 3 111)
_$

[_gile]

Hi,

If I understand the request, you can do it this way.


(defun sp-sort (lst)
(vl-sort lst
'(lambda (n1 n2 / s1 s2)
(setq s1 (substr (itoa n1) 1 1)
s2 (substr (itoa n2) 1 1)
)
(if (= s1 s2)
(< n1 n2)
(< s1 s2)
)
)
)
)

$ (setq lst '(2001 1 2000 10 1002 100 20 1000 2 200 1001 2002))
(2001 1 2000 10 1002 100 20 1000 2 200 1001 2002)
_$ (sp-sort lst)
(1 10 100 1000 1001 1002 2 20 200 2000 2001 2002)

[CAB2k]

One more:

_$ (setq lst '("3" "2" "111" "3"))
("3" "2" "111" "3")
_$ (mapcar '(lambda(x) (nth x lst))(vl-sort-i (mapcar 'read lst) '<))
("2" "3" "3" "111")
_$

[irneb]

In order to ensure that you sort numerically, instead of by ASCII value, you can convert to integer or real. So change your code as follows:
(defun sort (lst)
(vl-sort lst
'(lambda (e1 e2)
(<
(if (= 'STR (type (car e1))) ; If value is string
(read (car e1)) ; Change to numerical
(car e1) ; Else leave as is
) ;_ end of if
(if (= 'STR (type (car e2))) ; Do the same for e2
(read (car e2))
(car e2)
) ;_ end of if
) ;_ end of <
) ;_ end of lambda
) ;_ end of vl-sort
) ;_ end of defun

[ccowgill]

One more:

_$ (setq lst '("3" "2" "111" "3"))
("3" "2" "111" "3")
_$ (mapcar '(lambda(x) (nth x lst))(vl-sort-i (mapcar 'read lst) '<))
("2" "3" "3" "111")
_$

I dont know if you remember, but this is from the station offset program you helped me with back in 2006, I am trying to reuse it in another program, and it isn't working. I'll give this new version a try and see if it works better.

*edit - I tried the new version, what i am working with is a list that contains a string, then a list in each item of the list:
("1" (1 2 3))
("2" (1 2 3))

the first item is a string identifying point number, the second item is the x, y, and z coordinate. I need to sort the list by point number, because I am comparing it to another list that is already in point number order. Here is my entire code as it stands now, it appears to work fine, but I havent tested if for every scenario I can think of:



(defun c:updatepointfile (/ ss epfilename
jobno reductionfile
g0 i eppointfile
ename obj ipt
no pointlist sortedpointlist
epfileline currentpt count pointlen
)
;;select all blocks within modelspace that have attributes
(setq ss
(ssget "_X"
(list
'(0 . "insert")
'(66 . 1)
(cons 410 (getvar "ctab"))
) ;_ end of list
) ;_ end of ssget
epfilename (getfiled "select the Eagle Point File" "" "" 0)
jobno (strcat epfilename
"-updated.txt"
) ;_ end of strcat
reductionfile (open jobno "w")
) ;_ end of setq
(close reductionfile)
(vl-file-copy epfilename (strcat epfilename "old"))
(setq eppointfile (open (strcat epfilename "old") "r")
g0 (open epfilename "a")
i -1
) ;set counter

(while (setq ename (ssname ss (setq i (1+ i))))
;while objects exist in the selectionset
(setq obj (vlax-ename->vla-object ename)
ipt (vlax-get obj 'insertionpoint) ;get insertion point
no (get-no obj) ;get point number
pointlist (cons (list no ipt) pointlist)
count 0
pointlen (vl-list-length pointlist)
) ;_ end of setq
) ;_ end of while
(setq sortedpointlist pointlist)
(while (<= count pointlen)
(if (= (setq epfileline (read-line eppointfile)) nil)
(setq count (1+ count))
(progn
(setq currentpt (car sortedpointlist))
(cond
((wcmatch epfileline "PN`:*")
(while (/= epfileline (strcat "PN:" (car currentpt)))
(setq pointlist (cdr sortedpointlist)
currentpt (car sortedpointlist)
count (1+ count)
) ;_ end of setq
) ;_ end of while
(princ (strcat "PN:" (car currentpt) "\n") g0)
)
((wcmatch epfileline "YC`:*")
(princ (strcat "YC:" (rtos (cadr (car (cdr currentpt)))) "\n")
g0
) ;_ end of princ
)
((wcmatch epfileline "XC`:*")
(princ (strcat "XC:" (rtos (car (car (cdr currentpt)))) "\n")
g0
) ;_ end of princ
)
((wcmatch epfileline "ZC`:*")
(princ (strcat "ZC:" (rtos (caddr (car (cdr currentpt)))) "\n")
g0
) ;_ end of princ
(setq sortedpointlist (cdr sortedpointlist))
(setq count (1+ count))
)
((wcmatch epfileline "*")
(princ (strcat epfileline "\n") g0)
)
) ;_ end of cond
)
)
) ;_ end of while
(close g0)
(close eppointfile)
) ;_ end of defun

;(defun sort (lst)
; (vl-sort lst '(lambda (e1 e2) (< (car e1) (car e2))))
;) ;_ end of defun

(defun sort (lst / tmp)
(mapcar '(lambda(x) (nth x lst))(vl-sort-i (mapcar 'read lst) '<))
) ;_ end of defun

;; Return the description string from block
(defun get-no (blk / att) ;result result1 result2)
(foreach att (vlax-invoke blk 'getattributes)
(if (= (strcase (vla-get-tagstring att)) "PN")
(setq result (vla-get-textstring att))
) ;_ end of if
) ;_ end of foreach
(cond
((null result) "<Missing>")
(t result)
) ;_ end of cond
) ;_ end of defun



Thanks,

[CAB2k]

Hey Chris,
Yes I remember.
Check this out:

(defun c:test()
(setq lst '(
("2" (0 2 0))
("200" (0 2 0))
("2002"(0 2 0))
("100" (0 2 0))
("2000"(0 2 0))
("10" (0 2 0))
("1000"(0 2 0))
("1011"(0 2 0))
("20" (0 2 0))
("1" (0 2 0))
("2022"(0 2 0))
("1001"(0 2 0))
)
)
(setq SortedList
(mapcar '(lambda(x) (nth x lst))
(vl-sort-i (mapcar '(lambda(x)(read (car x))) lst) '<)))

(princ)
)

[ccowgill]

I'll give it a shot in the program, it appears to work great, I'm guessing the reason the old version didnt work was because it was designed for numbers, not strings, thinking back on it, I think we used the distance from 0 as our sort for the station offset program.

Thanks again,