马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。
您需要 登录 才可以下载或查看,没有账号?立即注册
×
本帖最后由 Lisphk 于 2020-2-13 13:49 编辑
- ;;Usage (SortStringWithNumberAsNumber '("A9" "A1" "A10" "B11" "B2" "B05"))
- ;;Return ("A1" "A9" "A10" "B2" "B05" "B11")
- (defun SortStringWithNumberAsNumber (ListOfString)
- ;;;Function Normalize (add 0 befor number) number in string
- ;;; Count normalize symbols set in variable count
- (defun NormalizeNumberInString (str / ch i pat ret count buf)
- (setq i 0
- pat '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9")
- ret ""
- count 4 ;_Count normalize symbols
- ) ;_ end of setq
- (while (/= (setq ch (substr str (setq i (1+ i)) 1)) "")
- (if (vl-position ch pat)
- (progn
- (setq buf ch) ;_ end of setq
- (while
- (vl-position (setq ch (substr str (setq i (1+ i)) 1)) pat)
- (setq buf (strcat buf ch))
- ) ;_ end of while
- (while (< (strlen buf) count) (setq buf (strcat "0" buf)))
- (setq ret (strcat ret buf))
- ) ;_ end of progn
- ) ;_ end of if
- (setq ret (strcat ret ch))
- ) ;_ end of while
- ret
- ) ;_ end of defun
- (vl-load-com)
- (mapcar '(lambda (x) (nth x ListOfString))
- (vl-sort-i (mapcar 'NormalizeNumberInString ListOfString)
- '<
- ) ;_ end of VL-SORT-I
- ) ;_ end of mapcar
- ) ;_ end of defun
- ;;Usage (SortStringWithNumberAsNumber '("A9" "A1" "A10" "B11" "B2" "B05") nil)
- ;;With ignore case (SortStringWithNumberAsNumber '("A9" "A1" "A10" "B11" "B2" "B05") t)
- ;; CAB added Ignore Case Flag as an argument
- ;;Return ("A1" "A9" "A10" "B2" "B05" "B11")
- (defun SortStringWithNumberAsNumber
- (ListOfString IgnoreCase / NorStrs count)
- ;;;Function Normalize (add 0 befor number) number in string
- ;;; Count normalize symbols set in variable count
- ;;; CAB added count as an argument
- (defun NormalizeNumberInString (str count / ch i pat ret buf)
- (setq i 0
- pat '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9")
- ret ""
- ) ;_ end of setq
- (while (/= (setq ch (substr str (setq i (1+ i)) 1)) "")
- (if (vl-position ch pat)
- (progn
- (setq buf ch) ;_ end of setq
- (while
- (vl-position (setq ch (substr str (setq i (1+ i)) 1)) pat)
- (setq buf (strcat buf ch))
- ) ;_ end of while
- (while (< (strlen buf) count) (setq buf (strcat "0" buf)))
- (setq ret (strcat ret buf))
- ) ;_ end of progn
- ) ;_ end of if
- (setq ret (strcat ret ch))
- ) ;_ end of while
- ret
- ) ;_ end of defun
- ;;-------------------------------------------------
- ;; function to Count the longest number in string
- ;; CAB added to get the correct COUNT
- (defun getcount (lst / count pat)
- (setq count 0)
- (setq pat '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9"))
- (mapcar
- '(lambda (str / i maxlen ch)
- (setq i 0
- maxlen 0
- )
- (while (/= (setq ch (substr str (setq i (1+ i)) 1)) "")
- (if (vl-position ch pat) ; number
- (setq maxlen (1+ maxlen))
- (setq count (max count maxlen)
- maxlen 0
- )
- )
- )
- (setq count (max count maxlen)) ;_<<< ADD 21.06.2007 by VVA
- )
- Lst
- )
- count
- )
- ;;===============================================
- (setq count (GetCount ListOfString)
- NorStrs (mapcar '(lambda (x) (NormalizeNumberInString x count))
- ListOfString
- )
- )
- (and IgnoreCase (setq NorStrs (mapcar 'strcase NorStrs)))
- (mapcar '(lambda (x) (nth x ListOfString))
- (vl-sort-i NorStrs '<)
- )
- ) ;_ end of defun
- ;; Alphanumerical Sort - Lee Mac
- ;; Sorts a list of strings containing a combination of alphabetical & numerical characters.
- (defun LM:alphanumsort (lst)
- (mapcar (function (lambda (n) (nth n lst)))
- (vl-sort-i (mapcar 'LM:splitstring lst)
- (function
- (lambda (a b / x y)
- (while
- (and
- (setq x (car a))
- (setq y (car b))
- (= x y)
- )
- (setq a (cdr a)
- b (cdr b)
- )
- )
- (cond
- ((null x) b)
- ((null y) nil)
- ((and (numberp x) (numberp y)) (< x y))
- ((numberp x))
- ((numberp y) nil)
- ((< x y))
- )
- )
- )
- )
- )
- )
- ;; Split String - Lee Mac
- ;; Splits a string into a list of text and numbers
- (defun LM:splitstring (str)
- (
- (lambda (l)
- (read
- (strcat
- "("
- (vl-list->string
- (apply
- 'append
- (mapcar
- (function
- (lambda (a b c)
- (cond
- ((= 92 b)
- (list 32 34 92 b 34 32)
- )
- ((or (< 47 b 58)
- (and (= 45 b) (< 47 c 58) (not (< 47 a 58)))
- (and (= 46 b) (< 47 a 58) (< 47 c 58))
- )
- (list b)
- )
- ((list 32 34 b 34 32))
- )
- )
- )
- (cons nil l)
- l
- (append (cdr l) '(()))
- )
- )
- )
- ")"
- )
- )
- )
- (vl-string->list str)
- )
- )
- (defun c:test ()
- (MySort '("T2A" "AS10" "T10B" "T1" "T2" "AS2" "T10" "T1A" "AS1" "T10A" "T1B" "T2B"))
- ;|
- ALE=====> ("AS1" "AS2" "AS10" "T1" "T2" "T10" "T10A" "T10B" "T1A" "T2A" "T1B" "T2B")
- LM:=====> ("AS1" "AS2" "AS10" "T1" "T1A" "T1B" "T2" "T2A" "T2B" "T10" "T10A" "T10B")
- Antistar> ("AS1" "AS2" "AS10" "T1" "T2" "T10" "T1A" "T2A" "T10A" "T1B" "T2B" "T10B") desired result
- CAB=====> ("AS1" "AS2" "AS10" "T1" "T1A" "T1B" "T2" "T2A" "T2B" "T10" "T10A" "T10B")
- |;
- )
- ;; CAB 01/30/14
- (defun parseNum (str / lst tnum tstr)
- (mapcar
- (function
- (lambda (x)
- (cond
- ((< 47 x 58) ; number
- (if tstr
- (setq lst (cons (vl-list->string (reverse tstr)) lst)
- tstr nil
- )
- )
- (if tnum
- (setq tnum (cons x tnum))
- (setq tnum (list x))
- )
- )
- (t ; non-number
- (if tnum
- (setq lst (cons (atoi (vl-list->string (reverse tnum))) lst)
- tnum nil
- )
- )
- (if tstr
- (setq tstr (cons x tstr))
- (setq tstr (list x))
- )
- )
- )
- )
- )
- (vl-string->list str)
- )
- (if tstr
- (setq lst (cons (vl-list->string (reverse tstr)) lst))
- )
- (if tnum
- (setq lst (cons (atoi (vl-list->string (reverse tnum))) lst))
- )
- (reverse lst)
- )
- (defun MySort (lst)
- (mapcar '(lambda (x) (nth x lst))
- (vl-sort-i (mapcar '(lambda(x) (ParseNum x)) lst)
- '(lambda (e1 e2)
- (if (= (car e1) (car e2))
- (if (= (cadr e1) (cadr e2))
- (< (caddr e1) (caddr e2))
- (< (cadr e1) (cadr e2))
- )
- (< (car e1) (car e2))
- )
- )
- )
- )
- )
- (defun mysort ( l )
- (vl-sort l
- (function
- (lambda ( a b / x y )
- (if (= (car a) (car b))
- (< (cadr a) (cadr b))
- (progn
- (setq a (LM:splitstring (car a))
- b (LM:splitstring (car b))
- )
- (while
- (and
- (setq x (car a))
- (setq y (car b))
- (= x y)
- )
- (setq a (cdr a)
- b (cdr b)
- )
- )
- (cond
- ( (null x) b)
- ( (null y) nil)
- ( (and (numberp x) (numberp y)) (< x y))
- ( (numberp x))
- ( (numberp y) nil)
- ( (< x y))
- )
- )
- )
- )
- )
- )
- )
- ;; Split String - Lee Mac
- ;; Splits a string into a list of text and numbers
- (defun LM:splitstring ( str )
- (
- (lambda ( l )
- (read
- (strcat "("
- (vl-list->string
- (apply 'append
- (mapcar
- (function
- (lambda ( a b c )
- (cond
- ( (= 92 b)
- (list 32 34 92 b 34 32)
- )
- ( (or (< 47 b 58)
- (and (= 45 b) (< 47 c 58) (not (< 47 a 58)))
- (and (= 46 b) (< 47 a 58) (< 47 c 58))
- )
- (list b)
- )
- ( (list 32 34 b 34 32))
- )
- )
- )
- (cons nil l) l (append (cdr l) '(( )))
- )
- )
- )
- ")"
- )
- )
- )
- (vl-string->list str)
- )
- )
- ;|
- _$ (mysort '(("A.05" 12.34 "Regular") ("A.10" 34.54 "BigSize") ("B.9" 66.73 "Regular") ("A.10" 12.12 "BigSize") ("A.05" 12.55 "BigSize")))
- (("A.05" 12.34 "Regular") ("A.05" 12.55 "BigSize") ("A.10" 12.12 "BigSize") ("A.10" 34.54 "BigSize") ("B.9" 66.73 "Regular"))
- |;
- (setq lst (list "PN375-A10.dwg"
- "PN375-A9.dwg"
- "PN375-A04.dwg"
- "PN375-A555.dwg"
- "PN375-D1.dwg"
- "PN375-D10.dwg"
- "PN375-D14.dwg"
- "PN375-D2.dwg"
- "PN375-D22.dwg"
- "PN375-D7r3.dwg"
- "PN375-DB.dwg"
- "PN375-DB10a.dwg"
- "PN375-DB9.dwg"))
- (mapcar '(lambda(x)(terpri)(princ x))
- (SortStringWithNumberAsNumber lst))
("PN375-A10.dwg" "PN375-A9.dwg" "PN375-A04.dwg" "PN375-A555.dwg" "PN375-D1.dwg" "PN375-D10.dwg" "PN375-D14.dwg" "PN375-D2.dwg" "PN375-D22.dwg" "PN375-D7r3.dwg" "PN375-DB.dwg" "PN375-DB10a.dwg" "PN375-DB9.dwg")
_$
PN375-A04.dwg
PN375-A9.dwg
PN375-A10.dwg
PN375-A555.dwg
PN375-D1.dwg
PN375-D2.dwg
PN375-D7r3.dwg
PN375-D10.dwg
PN375-D14.dwg
PN375-D22.dwg
PN375-DB.dwg
PN375-DB9.dwg
PN375-DB10a.dwg
("PN375-A04.dwg" "PN375-A9.dwg" "PN375-A10.dwg" "PN375-A555.dwg" "PN375-D1.dwg" "PN375-D2.dwg" "PN375-D7r3.dwg" "PN375-D10.dwg" "PN375-D14.dwg" "PN375-D22.dwg" "PN375-DB.dwg" "PN375-DB9.dwg" "PN375-DB10a.dwg")
_$
|