更改突出显示。
顺便说一句,不需要所有的附加。。。
- (defun ArchSort (lst / SplitStr comparable)
- ;; Gile & Lee Mac
- (defun SplitStr (str / lst test rslt num tmp)
-
- (setq lst (vl-string->list str)
- test (chr (car lst)))
-
- (if (< 47 (car lst) 58)
- (setq num T))
-
- (while (setq lst (cdr lst))
- (if num
- (cond ( (= 46 (car lst))
- (if (and (cadr lst)
- (setq tmp (strcat "0." (chr (cadr lst))))
- (numberp (read tmp)))
- (setq rslt (cons (read test) rslt) test tmp lst (cdr lst))
- (setq rslt (cons (read test) rslt) test "." num nil)))
- ( (< 47 (car lst) 58)
- (setq test (strcat test (chr (car lst)))))
- (T (setq rslt (cons (read test) rslt) test (chr (car lst)) num nil)))
- (if (< 47 (car lst) 58)
- (setq rslt (cons test rslt) test (chr (car lst)) num T)
- (setq test (strcat test (chr (car lst)))))))
-
- (if num
- (setq rslt (cons (read test) rslt))
- (setq rslt (cons test rslt)))
-
- (reverse rslt))
-
- (defun comparable (e1 e2)
- (or (and (numberp e1) (numberp e2))
- (= 'STR (type e1) (type e2))
- (not e1)
- (not e2)))
-
- (mapcar
- (function
- (lambda (x)
- (nth x lst)))
-
- (vl-sort-i (mapcar (function SplitStr) [color=Blue][b](mapcar (function car)[/b][/color] lst[b][color=Blue])[/color][/b])
- (function
- (lambda (x1 x2 / n1 n2 comp)
- (while
- (and (setq comp (comparable (setq n1 (car x1))
- (setq n2 (car x2))))
- (= n1 n2))
- (setq x1 (cdr x1) x2 (cdr x2)))
-
- (if comp (< n1 n2) (numberp n1)))))))
|