vl-sort issue

[zph]

Good day.  I am having an issue with vl-sort.

The list I am sorting has nested lists inside like this:

nList = ((a 1)(d 5)(c 2)(b 1))

I want to order the sublists in alphabetical order by their 1st element.  I've included the entire routine for context and I've highlited the vl-sort functions in RED.  I figure this is probably something very simple I'm missing and I am just not seeing it.

(defun c:testy ( /	tCntr sList nList *error* fPath fName tFpath Cable Reduce ssText tVal sList sCntr 
			tVal1 tCnt mCntr tVal2 tToF tFile dspMsg nList equal1 more1)

(vl-load-com)
(setvar "cmdecho" 0)
(setq tCntr 0)
(setq sList ())
(setq nList ())

(defun *error* (msg)
	(if (member msg '("Function cancelled" "quit / exit abort" "*Cancel*"))
		(progn (setvar "cmdecho" 1)(princ "\n <!> Routine aborted <!> "))
	) ;if
) ;*error*

(setq fPath "c:/Users/HULLZP/Desktop/CUSTOM")

(if (findfile fPath)
(progn (setq fName "/txtCount.txt")(setq tFpath (strcat fPath fName)))
(progn (princ "\n\033\n Invalid file path. See COUNTTEXT routine.")(exit))
) ;if

(princ "\n <ENTER> twice for default text count... ")

(initget "Y N")
(if (not (setq Cable (getkword "\n\033\n <Y> Reduce the selection set to cable numbers? [Y/N]:  ")))
(progn (princ "\n Y or N required.  Using default Y value!")(setq Cable "Y"))
) ;if

(initget "Y N")
(if (not (setq Reduce (getkword "\n\033\n <N> See only text with a count > 1? [Y/N]:  ")))
(progn (princ "\n Y or N required.  Using default N value!")(setq Reduce "N"))
) ;if

(if	(and	(princ "\n\033\n <> Select text objects to count: ")
		(setq ssText (ssget '((0 . "TEXT")(8 . "TEXT")(67 . 0))))
	) ;and

	(while (< tCntr (sslength ssText))
	(setq tVal (cdr (assoc 1 (entget (ssname ssText tCntr)))))

		(cond 	
			((= Cable "Y")
				(if	(and	(> (strlen tVal) 10)
						(wcmatch (substr tVal (- (strlen tVal) 3) 1) "-")
						(= (vl-string-search "," tVal) nil)
						(= (vl-string-search " " tVal) nil)
					) ;and
				(setq sList (append sList (list tVal)))
				) ;if
			)

			((= Cable "N")
				(setq sList (append sList (list tVal)))
			)
		) ;cond

	(setq tCntr (1+ tCntr))
	) ;while

	(progn (princ "\n\033\n < Selection set empty > ")(exit))
) ;if

(setq sCntr 0)
(setq tFile (open tFpath "w")) (close tFile)

(while (< sCntr (length sList))
(setq tVal1 (nth sCntr sList))
(setq tCnt 0)
(setq mCntr 0)

	(while (<= mCntr (length sList))
	(setq tVal2 (nth mCntr sList))
	(if (= (equal tVal1 tVal2) T)(setq tCnt (1+ tCnt))) ;if
	(setq mCntr (1+ mCntr))
	) ;while

(if (= (member (list tVal1 tCnt) nList) nil) (setq nList (cons (list tVal1 tCnt) nList)))
(setq sCntr (1+ sCntr))
) ;while

(cond
	((= Reduce "Y")
		(progn
		(foreach x nList (if (= (cadr x) 1) (setq nList (vl-remove x nList))))
		(setq nList (vl-sort nList '(lambda (x y) < (car x) (car y))))		
		) ;progn
	)

	((= Reduce "N")
		(progn
			(foreach x nList
				(if (= (cadr x) 1)
				(setq equal1 (cons x equal1))
				(setq more1 (cons x more1))
				) ;if
			) ;foreach

		(if equal1 (setq equal1 (vl-sort equal1 '(lambda (x y) < (car x) (car y)))))
		(if more1 (setq more1 (vl-sort more1 '(lambda (x y) < (car x) (car y)))))
		(setq nList (append more1 equal1))
		) ;progn
	)
) ;cond

(foreach x nList (setq nList (subst (strcat (car x) " count is: " (itoa (cadr x))) x nList)))
(foreach x nList (progn (setq tFile (open tFpath "a"))(write-line x tFile)(close tFile)))

(cond	((and (= Cable "Y")(= Reduce "Y"))(setq dspMsg "cable numbers with counts greater than 1."))
	((and (= Cable "Y")(= Reduce "N"))(setq dspMsg "cable numbers only."))
	((and (= Cable "N")(= Reduce "Y"))(setq dspMsg "all cables and text with counts greater than 1."))
	((and (= Cable "N")(= Reduce "N"))(setq dspMsg "all cables and text."))
) ;cond

(command "shell" tFpath)
(alert (strcat "Displaying:  " dspMsg
 "\n Please wait a moment while the text file is generated. \(" (itoa (sslength ssText)) " text objects\)"
 "\n  Larger selection sets \(1000+ text objects\) require additional time to process..."))
(princ (strcat "\n\033\n \(" (itoa (sslength ssText))))
(princ "\) text objects counted\n <!> Routine complete <!> ")
(princ)
) ;testy

[jdiala · Accepted solution]

didn't fully read the whole code but you are missing some parenthesis.

(setq nList (vl-sort nList '(lambda (x y) (< (car x) (car y)))))

(if equal1 (setq equal1 (vl-sort equal1 '(lambda (x y) (< (car x) (car y))))))
(if more1 (setq more1 (vl-sort more1 '(lambda (x y) (< (car x) (car y))))))

[Kent1Cooper]

---

@zph wrote:

Good day.  I am having an issue with vl-sort.

The list I am sorting has nested lists inside like this:

nList = ((a 1)(d 5)(c 2)(b 1))

I want to order the sublists in alphabetical order by their 1st element.  I've included the entire routine for context and I've highlited the vl-sort functions in RED.  I figure this is probably something very simple I'm missing and I am just not seeing it.

....
		(setq nList (vl-sort nList '(lambda (x y) < (car x) (car y))))		
....

---

Missing some parentheses in the comparison function:

  (setq nList (vl-sort nList '(lambda (x y) (< (car x) (car y)))))

[pbejse]

(vl-sort more1 '(lambda (x y) < (car x) (car y)))

missing a parenthesis

(vl-sort more1 '(lambda (x y) (< (car x) (car y))))

EDIT: 😄 I've forgotten how fast [ or how slow : depending on how you look at it ] posting here in ADESK forum. its been a while though. 

Anyhoo, if those are symbols instead of a string, 

(vl-sort more1
	   '(lambda (x y)
	      (< (vl-symbol-name (car x)) (vl-symbol-name (car y)))
	    )
  )

but i'm guessing it is a string by the looks of it

(setq tVal (cdr (assoc 1 (entget (ssname ssText tCntr)))))

[zph]

And see, I was thinking it was something really simple. hehe

I took a look at the time stamps on your guys posts: 1:45, 1:46, 1:47...You guys are fast!

[zph]

Yes, only "strings" are permitted based upon the initial selection set.

[zph]

Oh, and your solution(s) worked perfectly!

Thank you jdiala, Kent and pbejse.