分享自己编的编号字符串排序函数

ld_117

分享自己编的编号字符串排序函数，本人只求实现功能，不求深入学习lisp，所以函数写的比较冗长，仅作参考....
(orderLst (lst keyW))
功能：对lst根据关键字进行排序并列出相同元素的个数
参数：lst 字符串数列  keyW 关键字字符串
例  ：(orderLst '("KL5" "KL2(2)" "KL1a(2)" "KL2(2)" "KL1(1)") "KL")
        返回(("KL1(1)" . 1) ("KL1a(2)" . 1) ("KL2(2)" . 2) ("KL5" . 1))
作者：Ld_117

1. (vl-load-com)        ;将 Visual LISP 扩展功能加载到 AutoLISP
   
2. ;---------正则表达式设置---------
   
3. (setq reg (vlax-create-object "vbscript.regexp"))   ;创建正则表达式
   
4. (vlax-put-property reg 'global -1)                  ;是否匹配全部 （-1是 ，0 不是）
   
5. (vlax-put-property reg 'Multiline -1)               ;是否多行匹配 （-1是 ，0 不是）
   
6. (vlax-put-property reg 'IgnoreCase -1)              ;是否忽略大小写 （-1是 ，0 不是）
   
7. ;---------正则表达式设置结束---------
   
8. ;;排序函数开始
   
9. ;;(orderLst (lst keyW))
   
10. ;;功能：对lst根据关键字进行排序并列出相同元素的个数
    
11. ;;参数：lst 字符串数列  keyW 关键字字符串
    
12. ;;例  ：(orderLst '("KL5" "KL2(2)" "KL1a(2)" "KL2(2)" "KL1(1)") "KL")
    
13. ;;      返回(("KL1(1)" . 1) ("KL1a(2)" . 1) ("KL2(2)" . 2) ("KL5" . 1))
    
14. ;;作者：Ld_117
    
15. (defun orderLst (lst keyW / x nLst len i lLst tnLst nowLst nnLst)
    
16.   (setq nLst '() tnLst '())
    
17.   (foreach x lst
    
18.     (setq nLst (cons (cons x (getNum x keyW)) nLst));将lst做成点对形式
    
19.   )
    
20.   ;获得排序后的列表
    
21.   (foreach x (sortLst (reverse nLst))
    
22.     (setq tnLst (append tnLst (list (car x))))
    
23.   )
    
24.   (setq
    
25.     nLst tnLst
    
26.     len (vl-list-length nLst)
    
27.     i 0
    
28.     nowLst '()
    
29.     nNowLst '()
    
30.     nnLst '()
    
31.   )
    
32.   ;合并tnLst中相同元素并统计数量
    
33.   (while (< i len)
    
34.     (if (setq nowLst (assoc (nth i nLst) nnLst))
    
35.       (progn
    
36.         (setq nNowLst (cons (car nowLst) (1+ (cdr nowLst))))
    
37.         (setq nnLst (subst nNowLst nowLst nnLst))
    
38.       )
    
39.       (setq nnLst (cons (cons (nth i nLst) 1) nnLst))
    
40.     )
    
41.     (setq i (1+ i))
    
42.   )
    
43.   (setq nnLst (reverse nnLst))
    
44. )
    
45. ;;(getNum (str keyW))
    
46. ;;功能：获得str中紧跟keyW的编号字符，编号可以包含数字及字母
    
47. ;;参数：str 字符串  keyW 关键字字符串
    
48. ;;例  ：(getNum "KL5a(2)" "KL")
    
49. ;;      返回"5a"
    
50. ;;作者：Ld_117
    
51. (defun getNum (str keyW / matchcollect)
    
52.   (vlax-put-property reg 'pattern (strcat "^" keyW))
    
53.   (setq str (vlax-invoke-method reg 'Replace str ""))
    
54.   (vlax-put-property reg 'pattern "^[0-9a-zA-Z]+")
    
55.   (setq matchcollect (vlax-invoke-method reg 'Execute str))
    
56.   (vlax-for match_item matchcollect (setq str (car (list (eval (vlax-get-property match_item 'value))))))
    
57.   str
    
58. )
    
59. ;;(sortLst (lst))
    
60. ;;功能：调用vl-sort函数
    
61. (defun sortLst (lst)
    
62.   (vl-sort lst
    
63.     'sortLstFun
    
64.   )
    
65. )
    
66. ;;(sortLstFun (a b))
    
67. ;;功能：函数vl-sort中的比较函数，返回值为t则vl-sort对表中a、b元素位置进行调换
    
68. ;;参数：a 为lst中后一个列表元素  b 前一个列表元素
    
69. ;;例  ：(sortLstFun '("KL2" . "2") '("KL4" . "4"))
    
70. ;;      返回t
    
71. ;;作者：Ld_117
    
72. (defun sortLstFun (a b / a1 a2 b1 b2 len1 len2 len loop t1 t2 i)
    
73.   (setq
    
74.     a1 (cdr a)
    
75.     b1 (cdr b)
    
76.     result t
    
77.   )
    
78.   (vlax-put-property reg 'pattern "^[0-9]+")
    
79.   (setq matchcollect (vlax-invoke-method reg 'Execute (cdr a)))
    
80.   (vlax-for match_item matchcollect (setq a1 (car (list (eval (vlax-get-property match_item 'value))))))
    
81.   (setq a2 (vlax-invoke-method reg 'Replace (cdr a) ""))
    
82.   (setq matchcollect (vlax-invoke-method reg 'Execute (cdr b)))
    
83.   (vlax-for match_item matchcollect (setq b1 (car (list (eval (vlax-get-property match_item 'value))))))
    
84.   (setq b2 (vlax-invoke-method reg 'Replace (cdr b) ""))
    
85.   (if (> (atof a1) (atof b1))
    
86.     (setq result nil)
    
87.     (if (< (atof a1) (atof b1))
    
88.       (setq result t)
    
89.       (progn
    
90.         (if (= a2 nil) (setq a2 ""))
    
91.         (if (= b2 nil) (setq b2 ""))
    
92.         (setq
    
93.           len1 (strlen a2)
    
94.           len2 (strlen b2)
    
95.           len (max len1 len2)
    
96.           loop t
    
97.           i 1
    
98.         )
    
99.         (if (= len1 0)
    
100.           (setq result t)
     
101.           (if (= len2 0)
     
102.             (setq result nil)
     
103.             (while loop
     
104.               (setq
     
105.                 t1 (ASCII (substr a2 i 1))
     
106.                 t2 (ASCII (substr b2 i 1))
     
107.                 i (1+ i)
     
108.               )
     
109.               (if (< t1 t2)
     
110.                 (setq loop nil result t)
     
111.                 (if (> t1 t2)
     
112.                   (setq loop nil result nil)
     
113.                   (setq loop nil result nil)
     
114.                 )
     
115.               )
     
116.             )
     
117.           )
     
118.         )
     
119.       )
     
120.     )
     
121.   )
     
122.   result
     
123. )
     
124. ;;排序函数结束
     

(vl-load-com)        ;将 Visual LISP 扩展功能加载到 AutoLISP<br /> ;---------正则表达式设置---------<br /> (setq reg (vlax-create-object "vbscript.regexp"))   ;创建正则表达式<br /> (vlax-put-property reg 'global -1)                  ;是否匹配全部 （-1是 ，0 不是）<br /> (vlax-put-property reg 'Multiline -1)               ;是否多行匹配 （-1是 ，0 不是）<br /> (vlax-put-property reg 'IgnoreCase -1)              ;是否忽略大小写 （-1是 ，0 不是）<br /> ;---------正则表达式设置结束---------<br /> ;;排序函数开始<br /> ;;(orderLst (lst keyW))<br /> ;;功能：对lst根据关键字进行排序并列出相同元素的个数<br /> ;;参数：lst 字符串数列  keyW 关键字字符串<br /> ;;例  ：(orderLst '("KL5" "KL2(2)" "KL1a(2)" "KL2(2)" "KL1(1)") "KL")<br /> ;;      返回(("KL1(1)" . 1) ("KL1a(2)" . 1) ("KL2(2)" . 2) ("KL5" . 1))<br /> ;;作者：Ld_117<br /> (defun orderLst (lst keyW / x nLst len i lLst tnLst nowLst nnLst)<br />   (setq nLst '() tnLst '())<br />   (foreach x lst<br />     (setq nLst (cons (cons x (getNum x keyW)) nLst));将lst做成点对形式<br />   )<br />   ;获得排序后的列表<br />   (foreach x (sortLst (reverse nLst))<br />     (setq tnLst (append tnLst (list (car x))))<br />   )<br />   (setq<br />     nLst tnLst<br />     len (vl-list-length nLst)<br />     i 0<br />     nowLst '()<br />     nNowLst '()<br />     nnLst '()<br />   )<br />   ;合并tnLst中相同元素并统计数量<br />   (while (< i len)<br />     (if (setq nowLst (assoc (nth i nLst) nnLst))<br />       (progn<br />         (setq nNowLst (cons (car nowLst) (1+ (cdr nowLst))))<br />         (setq nnLst (subst nNowLst nowLst nnLst))<br />       )<br />       (setq nnLst (cons (cons (nth i nLst) 1) nnLst))<br />     )<br />     (setq i (1+ i))<br />   )<br />   (setq nnLst (reverse nnLst))<br /> )<br /> ;;(getNum (str keyW))<br /> ;;功能：获得str中紧跟keyW的编号字符，编号可以包含数字及字母<br /> ;;参数：str 字符串  keyW 关键字字符串<br /> ;;例  ：(getNum "KL5a(2)" "KL")<br /> ;;      返回"5a"<br /> ;;作者：Ld_117<br /> (defun getNum (str keyW / matchcollect)<br />   (vlax-put-property reg 'pattern (strcat "^" keyW))<br />   (setq str (vlax-invoke-method reg 'Replace str ""))<br />   (vlax-put-property reg 'pattern "^[0-9a-zA-Z]+")<br />   (setq matchcollect (vlax-invoke-method reg 'Execute str))<br />   (vlax-for match_item matchcollect (setq str (car (list (eval (vlax-get-property match_item 'value))))))<br />   str<br /> )<br /> ;;(sortLst (lst))<br /> ;;功能：调用vl-sort函数<br /> (defun sortLst (lst)<br />   (vl-sort lst<br />     'sortLstFun<br />   )<br /> )<br /> ;;(sortLstFun (a b))<br /> ;;功能：函数vl-sort中的比较函数，返回值为t则vl-sort对表中a、b元素位置进行调换<br /> ;;参数：a 为lst中后一个列表元素  b 前一个列表元素<br /> ;;例  ：(sortLstFun '("KL2" . "2") '("KL4" . "4"))<br /> ;;      返回t<br /> ;;作者：Ld_117<br /> (defun sortLstFun (a b / a1 a2 b1 b2 len1 len2 len loop t1 t2 i)<br />   (setq<br />     a1 (cdr a)<br />     b1 (cdr b)<br />     result t<br />   )<br />   (vlax-put-property reg 'pattern "^[0-9]+")<br />   (setq matchcollect (vlax-invoke-method reg 'Execute (cdr a)))<br />   (vlax-for match_item matchcollect (setq a1 (car (list (eval (vlax-get-property match_item 'value))))))<br />   (setq a2 (vlax-invoke-method reg 'Replace (cdr a) ""))<br />   (setq matchcollect (vlax-invoke-method reg 'Execute (cdr b)))<br />   (vlax-for match_item matchcollect (setq b1 (car (list (eval (vlax-get-property match_item 'value))))))<br />   (setq b2 (vlax-invoke-method reg 'Replace (cdr b) ""))<br />   (if (> (atof a1) (atof b1))<br />     (setq result nil)<br />     (if (< (atof a1) (atof b1))<br />       (setq result t)<br />       (progn<br />         (if (= a2 nil) (setq a2 ""))<br />         (if (= b2 nil) (setq b2 ""))<br />         (setq<br />           len1 (strlen a2)<br />           len2 (strlen b2)<br />           len (max len1 len2)<br />           loop t<br />           i 1<br />         )<br />         (if (= len1 0)<br />           (setq result t)<br />           (if (= len2 0)<br />             (setq result nil)<br />             (while loop<br />               (setq<br />                 t1 (ASCII (substr a2 i 1))<br />                 t2 (ASCII (substr b2 i 1))<br />                 i (1+ i)<br />               )<br />               (if (< t1 t2)<br />                 (setq loop nil result t)<br />                 (if (> t1 t2)<br />                   (setq loop nil result nil)<br />                   (setq loop nil result nil)<br />                 )<br />               )<br />             )<br />           )<br />         )<br />       )<br />     )<br />   )<br />   result<br /> )<br /> ;;排序函数结束<br />

yoyoho

支持下楼主,下载学习了!!!!

USER2128

我第一个出来支持你！放出源码才是正道！

zhengchuan

我也支持你！放出源码才是正道！

ld_117

USER2128 发表于 2015-1-27 11:39
我第一个出来支持你！放出源码才是正道！

你们能看到源码吗，我不常发帖不知道操作的对不对

lucas_3333

ld_117 发表于 2015-1-28 17:27
你们能看到源码吗，我不常发帖不知道操作的对不对

发贴没有问题，他是在赞扬你放出源码

ld_117

lucas_3333 发表于 2015-1-28 21:20
发贴没有问题，他是在赞扬你放出源码

本来想快点升级设置回复可见的。。。捣弄半天没弄成...

lucas_3333

ld_117 发表于 2015-1-28 23:53
本来想快点升级设置回复可见的。。。捣弄半天没弄成...

论坛不鼓励回复可见的，所以一般等级没这个权限， 另外回复的多少跟你升级没有关系

phoevana

支持源码，

emk

支持下楼主，没钱就不下了

ld_117

emk 发表于 2015-1-30 14:33
支持下楼主，没钱就不下了

不是贴源码了吗，复制是一样的，lsp文件是留给土豪下载的