土木在线论坛 \ 建筑设计 \ CAD下载及教程 \ 请高手改lisp

请高手改lisp

发布于:2006-11-24 12:45:24 来自:建筑设计/CAD下载及教程 [复制转发]
这是我在网上下的可以将文字内容刷成同样的lisp,但是只能一个一个的选,哪位高手能将它改成框选的啊,谢谢啦


;;;文字内容格式刷TM

(defun c:TM (/ e e2 ent ent2 en en2 newt oldt ent1 ent12 tst)
(setq tst t)
(setq e (car (entsel "\nPick a text or a attrib: ")))
(if (/= e nil)
(progn
(setq ent (entget e))
(cond
((and (= (cdr (assoc 0 ent)) "INSERT")
(= (cdr (assoc 66 ent)) 1)
)
(progn
(setq en (entget (setq ent (entnext e))))
(setq oldt (cdr (assoc 1 en)))
)
)
((= (cdr (assoc 0 ent)) "TEXT")
(setq oldt (cdr (assoc 1 ent)))
)
(T
(princ
"\nError: Not a text or not a block or no attrib in block !"
)
(setq tst nil)
)
)
)
(setq tst nil)
)
;;;----------------------------------------------------------------------
(while tst
(setq e2 (car (entsel "\nPick New a text or a attrib: ")))
(if (/= e2 nil)
(progn
(setq ent2 (entget e2))
(cond
((and (= (cdr (assoc 0 ent2)) "INSERT")
(= (cdr (assoc 66 ent2)) 1)
)
(progn
(setq en2 (entget (setq ent2 (entnext e2))))
(setq newt oldt)
(setq ent12
(subst (cons (car (assoc 1 en2)) newt) (assoc 1 en2) en2)
)
(entmod ent12)
(entupd ent2)
)
)
((= (cdr (assoc 0 ent2)) "TEXT")
(progn
(setq newt oldt)
(setq ent12 (subst (cons (car (assoc 1 ent2)) newt)
(assoc 1 ent2)
ent2
)
)
(entmod ent12)
)
)
(T
(princ
"\nError: Not a text or not a block or no attrib in block !"
)
(setq tst nil)
)
)
)
(setq tst nil)
)
)
;;;----------------------------------------------------------------------
(princ)
)

全部回复(8 )

只看楼主 我来说两句
  • honker1981
    honker1981 沙发
    刷尺寸的那个怎么不能用啊
    2008-04-04 12:59:04

    回复 举报
    赞同0
  • liweiping97065
    添加标注的那个程序怎么用啊,我好想知道啊
    2008-03-22 19:14:22

    回复 举报
    赞同0
加载更多
这个家伙什么也没有留下。。。

CAD下载及教程

返回版块

52.09 万条内容 · 668 人订阅

猜你喜欢

阅读下一篇

祝贺新版主上任

sp51086462成为电脑技术的新版主,让我等爱好电脑的人又多了个生力军。恭喜恭喜,祝贺祝贺。

回帖成功

经验值 +10