发布于: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 )
只看楼主 我来说两句回复 举报
回复 举报