申请编一个LISP程序

wcf · 发表于 2004-6-21 06:56:00

图中每个方向每个字符是单个的，相当于已经炸开的文本，编一个LISP程序能把如图中每个方向字符串中的相挨着的两个以上数字连起来，其它字符仍为炸开的情况，在屏幕上代换原文本，且能批量处理。最好R14及以上版本都能通用。这个题目有一定的难度，请高手解决。

ryuewf1vh5b.jpg

want · 发表于 2004-6-21 09:34:00

比较简单

petty · 发表于 2004-6-21 19:11:00

下载文字修改大师

wcf · 发表于 2004-6-21 21:46:00

文字修改大师无此功能。

meworld · 发表于 2004-6-24 12:46:00

给我两百块，我帮你做好．

meflying · 发表于 2004-6-24 14:27:00

[code](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 intlst)) (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)
         (

vumjuhajb0c.bmp

希版主抽时间修改一下，让R14的老用户能用，谢谢！

wcf · 发表于 2004-6-30 12:35:00

这是DWG文件吗？？？

申请编一个LISP程序

发表回复

精选推荐