lhg0196 发表于 2005-8-18 19:38:00

求助：如何用Lisp来更改块名称

<P>求助：如何用Lisp来更改块名称，其余块属性不变。多谢！</P>

meflying 发表于 2005-8-18 20:33:00

<P>(command "_.rename" "block" "bbb" "ccc")</P>
<P>;bbb和ccc分别是块的旧名和新名</P>

liu22737 发表于 2005-9-21 16:10:00

请问

请问如何更改无名块的名称

meflying 发表于 2005-9-21 21:00:00

<P>既然是"无名"块,怎么改"名"?</P>

liu22737 发表于 2005-9-21 21:45:00

我没说清楚

我的意思是对图中已有的匿名块 可否用lisp给它一个固定的名字

alin 发表于 2005-9-22 10:05:00

<P>Probably we cannot rename the anonymous blocks, but you can create a new block and copy all the objects&nbsp;from the original anonymous block. Then replace the original anonymous block reference.</P>

alin 发表于 2005-9-25 22:12:00

;;尽管也能为一般图块改名，但本程序主要是为匿名块改名成一般图块。<BR>;; Alin - 25/09/2005<BR>(defun c:RNBLK (/ doc oldBlkObj blks oldBlkDef oldOrigin oldNmae LOOP newName vla-objects sArray ss idc ent)<BR>&nbsp; (setq&nbsp;oldBlkObj (vlax-ename-&gt;vla-object<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (car (entsel "选择要改名的图块: "))<BR>&nbsp;&nbsp;&nbsp; )<BR>&nbsp; )<BR>&nbsp; (setq&nbsp;blks (vla-get-blocks<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq doc (vla-get-activedocument (vlax-get-acad-object)))<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<BR>&nbsp; )<BR>&nbsp; (setq oldBlkDef (vla-item blks (vla-get-name oldBlkObj)))<BR>&nbsp; (setq oldOrigin (vla-get-origin oldBlkDef))<BR>&nbsp; (princ "\n原图块名为：")<BR>&nbsp; (princ (setq oldName (vla-get-name oldBlkObj)))<BR>&nbsp; (setq LOOP t)<BR>&nbsp; (while LOOP<BR>&nbsp;&nbsp;&nbsp; (if&nbsp;(not<BR>&nbsp;&nbsp; (tblsearch<BR>&nbsp;&nbsp;&nbsp;&nbsp; "block"<BR>&nbsp;&nbsp;&nbsp;&nbsp; (setq newName (getstring "\n输入新的图块名："))<BR>&nbsp;&nbsp; )<BR>&nbsp;)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq LOOP nil)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (princ "\n该图块名在本图中已定义过，请另选。")<BR>&nbsp;&nbsp;&nbsp; )<BR>&nbsp; )<BR>&nbsp; (setq newBlkDef (vla-add blks oldOrigin newName))<BR>&nbsp; (setq vla-objects '())<BR>&nbsp; (vlax-for obj&nbsp;oldBlkDef<BR>&nbsp;&nbsp;&nbsp; (setq vla-objects (cons obj vla-objects))<BR>&nbsp; )<BR>&nbsp; (setq&nbsp;sArray (vlax-safearray-fill<BR>&nbsp;&nbsp; (vlax-make-safearray<BR>&nbsp;&nbsp;&nbsp;&nbsp; vlax-vbobject<BR>&nbsp;&nbsp;&nbsp;&nbsp; (cons 0 (1- (length vla-objects)))<BR>&nbsp;&nbsp; )<BR>&nbsp;&nbsp; vla-objects<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<BR>&nbsp; )<BR>&nbsp; (vla-copyobjects doc sArray newBlkDef nil)<BR>&nbsp; (setq ss (ssget "x" (list (cons 0 "INSERT") (cons 2 (strcat "`" oldName)))))<BR>&nbsp; (setq idx 0)<BR>&nbsp; (while (&lt; idx (sslength ss))<BR>&nbsp;&nbsp;&nbsp; (setq ent (entget (ssname ss idx)))<BR>&nbsp;&nbsp;&nbsp; (setq ent (subst (cons 2 newName) (assoc 2 ent) ent))<BR>&nbsp;&nbsp;&nbsp; (setq ent (subst (cons 70 0) (assoc 70 ent) ent))<BR>&nbsp;&nbsp;&nbsp; (entmod ent)<BR>&nbsp;&nbsp;&nbsp; (setq idx (1+ idx))<BR>&nbsp; )<BR>&nbsp; (princ)<BR>)

594826903 发表于 2019-12-24 14:35:55

很好的程序支持下！
页: [1]
查看完整版本: 求助：如何用Lisp来更改块名称