tanle2020
发表于 2009-5-25 13:09:00
[推荐]修改任何文字（包括属性块、有名无名块）
<font face="宋体" size="2">转发一好用程序，可修改任何文字，唯独不能修改尺寸文字，望原创作者或各位高手能修改一下。<br/>LISP：<br/>;自定义UnDo范围<br/>(defun EF:UNDOBegin ()<br/>(setvar "CMDECHO" 0 )<br/>(command "_.undo" "_group")<br/>(princ)<br/>) ;end defun<br/>(defun EF:UNDOEnd()<br/>(setvar "CMDECHO" 0)<br/>(command "_.undo" "_end")<br/>(princ)<br/>) ;end defun<br/>(defun c:tt( / dcl_id1 oba ob1 obn obt ptn otxt txt sty styno lay cyn layno hig wid ang col cnu etlst style layer)<br/>(graphscr)<br/>(EF:UNDOBegin)<br/>(setq olderr *error*)<br/>(defun *error*(msg)<br/>(princ "\n*ERROR*...")<br/>(princ msg)<br/>(princ)<br/>);end defun error.<br/>(defun set_color ( conm / costr )<br/>(defun map_color ( ckey mno )<br/>(start_image ckey)<br/>(fill_image 0 0 (DimX_tile ckey) (DimY_tile ckey) mno)<br/>(end_image)<br/>) ;end defun<br/>(cond ((= 0 conm)(setq costr "Byblock"))<br/>((= 1 conm)(setq costr "Red"))<br/>((= 2 conm)(setq costr "Yellow"))<br/>((= 3 conm)(setq costr "Green"))<br/>((= 4 conm)(setq costr "Cyan"))<br/>((= 5 conm)(setq costr "Bule"))<br/>((= 6 conm)(setq costr "Magenta"))<br/>((= 7 conm)(setq costr "color"))<br/>((= 256 conm)(setq costr "Bylayer"))<br/>( t (setq costr ""))<br/>) ;end cond<br/>(cond ((= 0 col) (map_color "col" 7))<br/>((= 256 col)(map_color "col" (cdr (assoc 62 (tblsearch "layer" lay)))))<br/>(t (map_color "col" conm))<br/>) ;end cond<br/>(if (= 256 conm)<br/>(set_tile "cnu" (strcat "<" (itoa (cdr (assoc 62 (tblsearch "layer" lay)))) ">" costr))<br/>(set_tile "cnu" (strcat "<" (itoa conm) ">" costr))<br/>) ;end if<br/>) ;end set_color<br/>(defun map_keylist( key keylst );set popuplist<br/>(start_list key)<br/>(mapcar 'add_list keylst)<br/>(end_list)<br/>);end map<br/>(defun layer_get_all( / lay layer layname)<br/>(setq layer nil ;;All layer<br/>lay (tblnext "LAYER" T)<br/>)<br/>(while (/= lay nil)<br/>(setq layname (cdr (assoc 2 lay))<br/>layer (cons layname layer))<br/>(setq lay (tblnext "LAYER"))<br/>)<br/>(setq layer (ACAD_Strlsort layer))<br/>layer ;all layer.<br/>) ;end defun<br/>(defun style_get_all( / sty style sty_list)<br/>(setq sty_list nil sty (tblnext "style" t))<br/>(setq style (cdr (assoc 2 sty)))<br/>(while style<br/>(if (/= "" style)(setq sty_list (append sty_list (list style))))<br/>(setq sty (tblnext "style"))<br/>(setq style (cdr (assoc 2 sty)))<br/>);end while]<br/>(setq sty_list (ACAD_Strlsort sty_list))<br/>sty_list<br/>);end defun<br/>(defun set_error(str)<br/>(set_tile "error" str)<br/>) ;end defun<br/>(defun sub_mtext ( color entlist / ei newlist)<br/>(setq ei 0 newlist nil)<br/>(while (< ei (length entlist))<br/>(setq newlist (cons (nth ei entlist) newlist))<br/>(if (= 8 (car (nth ei entlist)))<br/>(setq newlist (cons (cons 62 color) newlist))<br/>) ;end if<br/>(setq ei (1+ ei))<br/>) ;end while<br/>(reverse newlist) <br/>) ;end defun<br/>(setq ob1 (entsel "\n选择要修改的任何文本:"))<br/>(SETQ obn (car ob1) ptn (car (cdr ob1 )))<br/>(setq obt (car (nentselp ptn)))<br/>(setq oba (cdr (assoc 0 (entget obt))))<br/>(if (or (= oba "TEXT")(= oba "MTEXT")(= oba "ATTRIB"))<br/>(setq otxt (cdr (assoc 1 (entget obt))))<br/>) ;end if<br/>(if (= oba "ATTDEF")<br/>(setq otxt (cdr (assoc 2 (entget obt))))<br/>) ;end if<br/>(if otxt<br/>(progn<br/>(setq <br/>sty (cdr (assoc 7 (entget obt)))<br/>lay (cdr (assoc 8 (entget obn)))<br/>hig (cdr (assoc 40 (entget obt)))<br/>wid (cdr (assoc 41 (entget obt)))<br/>ang (cdr (assoc 50 (entget obt)))<br/>) ;end setq<br/>(if (or (= oba "TEXT")(= oba "MTEXT")(= oba "ATTRIB"))<br/>(setq col (cdr (assoc 62 (entget obt))))<br/>(setq col (cdr (assoc 62 (entget obn))))<br/>) ;end if<br/>(setq ang (* 180 (/ ang pi)))<br/>(if (null col)(progn (setq cyn 0)(setq col 256))(setq cyn 1))<br/>(setq style (style_get_all))<br/>(setq layer (layer_get_all))<br/>(setq styno (- (length style)(length (member sty style))))<br/>(setq layno (- (length layer)(length (member lay layer))))<br/>(setq dcl_id1 (load_dialog "文字修改.DCL"))<br/>(if (not (new_dialog "文字修改" dcl_id1))(exit))<br/>(set_color col)<br/>(set_tile "text" otxt)<br/>(set_tile "hig" (rtos hig 2 2))<br/>(set_tile "wid" (rtos wid 2 2))<br/>(set_tile "ang" (rtos ang 2 2))<br/>(mode_tile "text" 2)<br/>(map_keylist "sty" style)(set_tile "sty" (itoa styno))<br/>(map_keylist "lay" layer)(set_tile "lay" (itoa layno))<br/>(action_tile "text" "(setq txt $value)")<br/>(action_tile "sty" "(setq styno (atoi $value))")<br/>(action_tile "hig" "(setq hig (distof $value))(if (>= 0 hig)(progn (mode_tile \"hig\" 3)(mode_tile \"hig\" 2)(set_error \"Input error ! \"))(set_error \"\"))")<br/>(action_tile "wid" "(setq wid (distof $value))(if (>= 0 wid)(progn (mode_tile \"wid\" 3)(mode_tile \"wid\" 2)(set_error \"Input error ! \"))(set_error \"\"))")<br/>(action_tile "lay" "(setq layno (atoi $value))")<br/>(action_tile "col" "(if (setq cnu (ACAD_ColorDlg col))(progn (setq col cnu)(set_color col)))")<br/>(action_tile "ang" "(setq ang (distof $value))")<br/>(action_tile "accept" "(done_dialog 1)")<br/>(action_tile "cancel" "(done_dialog 0)")<br/><br/>(if (= 1 (start_dialog))<br/>(if txt<br/>(progn<br/>(setq sty (nth styno style))<br/>(setq lay (nth layno layer))<br/>(setq ang (* (/ ang 180) pi))<br/>(setq etlst (entget obt))<br/>(if (= oba "ATTDEF")<br/>(setq etlst (subst (cons 2 txt)(assoc 2 etlst) etlst))<br/>(setq etlst (subst (cons 1 txt)(assoc 1 etlst) etlst))<br/>) ;end if<br/>(setq etlst (subst (cons 7 sty)(assoc 7 etlst) etlst))<br/>(setq etlst (subst (cons 40 hig)(assoc 40 etlst) etlst))<br/>(setq etlst (subst (cons 41 wid)(assoc 41 etlst) etlst))<br/>(setq etlst (subst (cons 50 ang)(assoc 50 etlst) etlst))<br/>(if (= 1 cyn)<br/>(setq etlst (subst (cons 62 col)(assoc 62 etlst) etlst))<br/>(if (= "MTEXT" oba)<br/>(setq etlst (sub_mtext col etlst))<br/>(setq etlst (cons (cons 62 col) etlst))<br/>) ;end if<br/>) ;end if<br/>(entmod etlst)<br/>(setq etlst (subst (cons 8 lay)(assoc 8 (entget obn)) (entget obn)))<br/>(entmod etlst)<br/>(entupd obt)<br/>(entupd obn)<br/>)<br/>) ;end if<br/>);end if<br/>(if (= 11 (start_dialog))(Command "_help"))<br/>) ;end progn<br/>) ;end if<br/>(setq *error* olderr)<br/>(EF:UNDOEnd)<br/>(princ)<br/>) ;end defun<br/><br/>；；；；；；；；；；；；；；；；；；；；；；；；；；；；；<br/><br/>DCL：<br/>//SUPERDDEDIT<br/>文字修改: dialog {<br/>label = "文字编辑...";<br/>: boxed_radio_column {<br/>label = "超级文字编辑...";<br/>: edit_box { label= "文字:"; key = "text"; edit_width = 50; }<br/>: row {<br/>: popup_list {label="样式"; key = "sty"; edit_width = 13; fixed_width = true;}<br/>: edit_box {label="高度"; key = "hig"; edit_width = 7; fixed_width = true;}<br/>: edit_box {label="宽度"; key = "wid"; edit_width = 7; fixed_width = true;}<br/>}<br/>: row {<br/>: popup_list {label="图层"; key = "lay"; edit_width = 13; fixed_width = true;}<br/>: image_button {key = "col"; width= 4; aspect_ratio = 0.75; fixed_width = true;}<br/>: text_part {key = "cnu"; width= 12;fixed_width = true; }<br/>: edit_box {label="角度"; key = "ang"; edit_width = 7; fixed_width = true;}<br/>}<br/>spacer_1;<br/>}<br/>: row {<br/>alignment = right;<br/>: spacer {width = 1; fixed_width = true;}<br/>ok_cancel;<br/>}<br/>errtile;<br/>}</font>
samshs
发表于 2009-5-25 13:54:00
學習一下
aeo000000
发表于 2009-5-25 21:38:00
<strong>有名无名块:程序里没看出来</strong>
tanle2020
发表于 2009-5-26 09:44:00
试一试就知道咯
samshs
发表于 2009-5-26 13:49:00
<p>你爲什麽不做個LSP文件及DCL文件下載就可以啦</p>
XIAOFEILONG
发表于 2009-5-26 21:41:00
<p>用了一下</p><p>觉得在画图的时候,这个程序的作用好象不大啊</p>
azjmjsj
发表于 2009-5-27 20:03:00
此程序是个好工具，方便实用，特别适合块文字，属性文字的编辑（适合处理外国图纸）。我修改了一下，增加了<font size="2">尺寸文字编辑功能。想用的到<a href="http://xbfr.ys168.com/">http://xbfr.ys168.com/</a>下载<br/>-->-->[超级文本编辑器]</font>
tanle2020
发表于 2009-5-29 13:14:00
<p>可否把修改后的源码发到我邮箱，谢谢！</p><p><a href="mailto:640244434@qq.com">640244434@qq.com</a></p>
Michael527
发表于 2009-6-5 20:46:00
7楼的不厚道，把人家楼主的源码还给编译了
Michael527
发表于 2009-6-5 21:04:00
嵌套块中的文字修改不了