申请编一个LISP程序

meflying

自己发现了个错误，改了一下：
(defun c:test (/ ss i j ent ents ang item lst str intlst xl-sort xl-isort To)
;(xl-sort lst fun) = 以取代vl-sort函数，用法相同(lsp)---------------by 无痕
(defun xl-sort (lst fun / nlst)
(foreach n lst (setq nlst (xl-isort n nlst fun)))
)
(defun xl-isort (item lst fun / k nlst)
(setq k T
nlst (apply 'append
(mapcar '(lambda (x)
(if (and K ((eval fun) item x))
(progn (setq k nil) (list item x))
(list x)
)
)
lst
)
)
)
(if k
(append lst (list item))
nlst
)
)
(defun To (entlst / str ents)
(setq str (apply 'strcat
(mapcar '(lambda (e) (cdr (assoc 1 e))) entlst)
)
)
(setq ents (subst (cons 1 str) (assoc 1 (car entlst)) (car entlst)))
(entmod ents)
(mapcar 'entdel
(mapcar '(lambda (e) (cdr (assoc -1 e))) (cdr entlst))
)
)
(setq ss (ssget '((0 . "TEXT"))))
(setq i 0)
(setq lst nil
intlst nil
)
(repeat (sslength ss)
(setq ent (ssname ss i))
(setq ents (entget ent))
(setq ang (cdr (assoc 50 ents)))
(if (setq item (assoc ang lst))
(setq lst (subst (append item (list ents)) item lst))
(setq lst (append lst (list (list ang ents))))
)
(setq i (1+ i))
)
(setq i 0)
(setq lst
(mapcar
'(lambda (e)
(cons
(car e)
(vl-sort (cdr e)
'(lambda (e1 e2)
(< (cadr (assoc 10 e1)) (cadr (assoc 10 e2)))
)
)
)
)
lst
)
)
(repeat (length lst)
(setq item (nth i lst))
(setq j 1)
(repeat (1- (length item))
(setq ents (nth j item))
(setq str (cdr (assoc 1 ents)))
(if (= (type (read str)) 'INT)
(setq intlst (append intlst (list ents)))
(if intlst
(progn
(To (reverse intlst))
(setq intlst nil)
)
)
)
(setq j (1+ j))
)
(if intlst
(To （reverse intlst))
)
(setq i (1+ i))
)
(princ)
)

wcf

在2002下测试还是有字符乱串现象，在14下不能运行。

meflying

怎么就不愿意提供一个有问题的图呢？？？？？？我好调试啊。。。

wcf

不好意思，老出差，不能及时回贴。

meflying

？？？


再看看10楼的和8楼的