【K:AnalNum4STR】含数字的字符串排序(类似Windows排序)

kucha007

该函数可在字符串的数字前面加"0"，使得字符串中的数字部分强制满足位数
从而可以用于对文件名等含数字的字符串进行排序，排序结果类似Windows

该函数最早的灵感来自帖子：http://www.theswamp.org/index.php?topic=16564.0
我在这篇帖子思路的基础上，针对CAD高版本做了点优化，并且将字符串先拆分成单字再找数字。
在函数规整数字的过程中，我还去除了字符串中的空格和各种括号，这些对象一般也不用作排序依据
目前函数已经实际运用在这个程序中：http://bbs.mjtd.com/thread-188813-1-1.html


分享给大家，欢迎大家继续改进。

2. ;分析字符串中的数字,强制满足位数并返回(在数字前加上0)
   
3. (defun K:AnalNum4STR (Count STR / K:ExplodeSTR2One RtnSTR NumLst STRLst CurSTR TotNum TmpSTR)
   
4.   ;将字符串拆分成单字符列表
   
5.   (defun K:ExplodeSTR2One (STR / RtnSTR)
   
6.     (while (> (strlen STR) 0)
   
7.       (cond
   
8.         ((> (ascii (substr STR 1 1)) 128) ;大于128为汉字
   
9.           (if
   
10.             (and
    
11.               (>= (atoi (substr (ver) 13)) 2021)
    
12.               (/= (getvar "lispsys") 0)
    
13.             )
    
14.             (progn
    
15.               (setq RtnSTR (cons (substr STR 1 1) RtnSTR))
    
16.               (setq STR (substr STR 2))
    
17.             )
    
18.             (progn
    
19.               (setq RtnSTR (cons (substr STR 1 2) RtnSTR))
    
20.               (setq STR (substr STR 3))
    
21.             )
    
22.           )
    
23.         )
    
24.         (T
    
25.           (setq RtnSTR (cons (substr STR 1 1) RtnSTR))
    
26.           (setq STR (substr STR 2))
    
27.         )
    
28.       )
    
29.     )
    
30.     (reverse RtnSTR)
    
31.   )
    
32.   (if (and STR (= 'STR (type STR)))
    
33.       (progn
    
34.           (setq RtnSTR ""
    
35.                 NumLst (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9")
    
36.                 STRLst (K:ExplodeSTR2One STR)
    
37.           )
    
38.           (while STRLst
    
39.               (setq CurSTR (car STRLst)
    
40.                     STRLst (cdr STRLst)
    
41.               )
    
42.               (if (member CurSTR NumLst);找到了数字
    
43.                 (progn
    
44.                     (setq TotNum 1);数字连续的次数
    
45.                     (while (member (setq TmpSTR (car STRLst)) NumLst);下一个也是数字
    
46.                           (setq TotNum (1+ TotNum)
    
47.                                 STRLst (cdr STRLst)
    
48.                                 CurSTR (strcat CurSTR TmpSTR)
    
49.                           )
    
50.                     )
    
51.                     (repeat (- Count TotNum)
    
52.                         (setq CurSTR (strcat "0" CurSTR))
    
53.                     );不足位数前面加零
    
54.                     (setq RtnSTR (strcat RtnSTR CurSTR))
    
55.                 )
    
56.                 (if (not (member CurSTR '(" " "（" "）" "(" ")" "[" "]" "{" "}" "【" "】")));移除空格和括号
    
57.                     (setq RtnSTR (strcat RtnSTR CurSTR))
    
58.                 )
    
59.               )
    
60.             )
    
61.       )
    
62.   )
    
63.   RtnSTR
    
64. )

;分析字符串中的数字,强制满足位数并返回(在数字前加上0)<br /> (defun K:AnalNum4STR (Count STR / K:ExplodeSTR2One RtnSTR NumLst STRLst CurSTR TotNum TmpSTR) <br />   ;将字符串拆分成单字符列表<br />   (defun K:ExplodeSTR2One (STR / RtnSTR)<br />     (while (> (strlen STR) 0)<br />       (cond<br />         ((> (ascii (substr STR 1 1)) 128) ;大于128为汉字<br />           (if <br />             (and<br />               (>= (atoi (substr (ver) 13)) 2021)<br />               (/= (getvar "lispsys") 0)<br />             )<br />             (progn <br />               (setq RtnSTR (cons (substr STR 1 1) RtnSTR))<br />               (setq STR (substr STR 2))<br />             )<br />             (progn <br />               (setq RtnSTR (cons (substr STR 1 2) RtnSTR))<br />               (setq STR (substr STR 3))<br />             )<br />           )<br />         )<br />         (T<br />           (setq RtnSTR (cons (substr STR 1 1) RtnSTR))<br />           (setq STR (substr STR 2))<br />         )<br />       )<br />     )<br />     (reverse RtnSTR)<br />   )<br />   (if (and STR (= 'STR (type STR)))<br />       (progn<br />           (setq RtnSTR ""<br />                 NumLst (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9")<br />                 STRLst (K:ExplodeSTR2One STR)<br />           )<br />           (while STRLst<br />               (setq CurSTR (car STRLst)<br />                     STRLst (cdr STRLst)<br />               )<br />               (if (member CurSTR NumLst);找到了数字<br />                 (progn <br />                     (setq TotNum 1);数字连续的次数<br />                     (while (member (setq TmpSTR (car STRLst)) NumLst);下一个也是数字<br />                           (setq TotNum (1+ TotNum)<br />                                 STRLst (cdr STRLst)<br />                                 CurSTR (strcat CurSTR TmpSTR)<br />                           )<br />                     )<br />                     (repeat (- Count TotNum)<br />                         (setq CurSTR (strcat "0" CurSTR))<br />                     );不足位数前面加零<br />                     (setq RtnSTR (strcat RtnSTR CurSTR))<br />                 )<br />                 (if (not (member CurSTR '(" " "（" "）" "(" ")" "[" "]" "{" "}" "【" "】")));移除空格和括号<br />                     (setq RtnSTR (strcat RtnSTR CurSTR))<br />                 ) <br />               )<br />             )<br />       )<br />   )<br />   RtnSTR<br /> )

函数用法：

1. (K:AnalNum4STR 5 "PN375-A10.dwg")
   
2. ;返回："PN00375-A00010.dwg"
   

(K:AnalNum4STR 5 "PN375-A10.dwg")<br /> ;返回："PN00375-A00010.dwg"<br />

排序用法：

2. ;假设我们的有一个表
   
3. (setq DataLst (list "A9.DWG" "A1.DWG" "A10.DWG" "B11.DWG" "B2.DWG" "B05.DWG"))
   
4. 
   
5. (setq DataLst (vl-sort DataLst '(lambda (x y) (< x y))))
   
6. ;直接排序将得到错误的结果
   
7. ;返回：("A1.DWG" "A10.DWG" "A9.DWG" "B05.DWG" "B11.DWG" "B2.DWG")
   
8. 
   
9. (setq DataLst (vl-sort DataLst
   
10.                        '(lambda (x y)
    
11.                           (< (K:AnalNum4STR 5 x) (K:AnalNum4STR 5 y))
    
12.                         )
    
13.               )
    
14. )
    
15. ;使用函数处理后排序将得到我们想要的结果
    
16. ;返回：("A1.DWG" "A9.DWG" "A10.DWG" "B2.DWG" "B05.DWG" "B11.DWG")

;假设我们的有一个表<br /> (setq DataLst (list "A9.DWG" "A1.DWG" "A10.DWG" "B11.DWG" "B2.DWG" "B05.DWG"))<br /> <br /> (setq DataLst (vl-sort DataLst '(lambda (x y) (< x y))))<br /> ;直接排序将得到错误的结果<br /> ;返回：("A1.DWG" "A10.DWG" "A9.DWG" "B05.DWG" "B11.DWG" "B2.DWG")<br /> <br /> (setq DataLst (vl-sort DataLst <br />                        '(lambda (x y) <br />                           (< (K:AnalNum4STR 5 x) (K:AnalNum4STR 5 y))<br />                         )<br />               )<br /> )<br /> ;使用函数处理后排序将得到我们想要的结果<br /> ;返回：("A1.DWG" "A9.DWG" "A10.DWG" "B2.DWG" "B05.DWG" "B11.DWG")

sncokina

感谢分享，看上去很实用。。

lxl217114

感谢分享，谢谢大佬发布新品。

magicheno

感谢大佬分享分享

你有种再说一遍

微软应该是用红黑树实现的

Qwer1243

感谢楼主的分享，代码很好用