[推荐]修改任何文字（包括属性块、有名无名块）

tanle2020

转发一好用程序，可修改任何文字，唯独不能修改尺寸文字，望原创作者或各位高手能修改一下。
LISP：
;自定义UnDo范围
(defun EF:UNDOBegin ()
(setvar "CMDECHO" 0 )
(command "_.undo" "_group")
(princ)
) ;end defun
(defun EF:UNDOEnd()
(setvar "CMDECHO" 0)
(command "_.undo" "_end")
(princ)
) ;end defun
(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)
(graphscr)
(EF:UNDOBegin)
(setq olderr *error*)
(defun *error*(msg)
(princ "\n*ERROR*...")
(princ msg)
(princ)
);end defun error.
(defun set_color ( conm / costr )
(defun map_color ( ckey mno )
(start_image ckey)
(fill_image 0 0 (DimX_tile ckey) (DimY_tile ckey) mno)
(end_image)
) ;end defun
(cond ((= 0 conm)(setq costr "Byblock"))
((= 1 conm)(setq costr "Red"))
((= 2 conm)(setq costr "Yellow"))
((= 3 conm)(setq costr "Green"))
((= 4 conm)(setq costr "Cyan"))
((= 5 conm)(setq costr "Bule"))
((= 6 conm)(setq costr "Magenta"))
((= 7 conm)(setq costr "color"))
((= 256 conm)(setq costr "Bylayer"))
( t (setq costr ""))
) ;end cond
(cond ((= 0 col) (map_color "col" 7))
((= 256 col)(map_color "col" (cdr (assoc 62 (tblsearch "layer" lay)))))
(t (map_color "col" conm))
) ;end cond
(if (= 256 conm)
(set_tile "cnu" (strcat "<" (itoa (cdr (assoc 62 (tblsearch "layer" lay)))) ">" costr))
(set_tile "cnu" (strcat "<" (itoa conm) ">" costr))
) ;end if
) ;end set_color
(defun map_keylist( key keylst );set popuplist
(start_list key)
(mapcar 'add_list keylst)
(end_list)
);end map
(defun layer_get_all( / lay layer layname)
(setq layer nil ;;All layer
lay (tblnext "LAYER" T)
)
(while (/= lay nil)
(setq layname (cdr (assoc 2 lay))
layer (cons layname layer))
(setq lay (tblnext "LAYER"))
)
(setq layer (ACAD_Strlsort layer))
layer ;all layer.
) ;end defun
(defun style_get_all( / sty style sty_list)
(setq sty_list nil sty (tblnext "style" t))
(setq style (cdr (assoc 2 sty)))
(while style
(if (/= "" style)(setq sty_list (append sty_list (list style))))
(setq sty (tblnext "style"))
(setq style (cdr (assoc 2 sty)))
);end while]
(setq sty_list (ACAD_Strlsort sty_list))
sty_list
);end defun
(defun set_error(str)
(set_tile "error" str)
) ;end defun
(defun sub_mtext ( color entlist / ei newlist)
(setq ei 0 newlist nil)
(while (< ei (length entlist))
(setq newlist (cons (nth ei entlist) newlist))
(if (= 8 (car (nth ei entlist)))
(setq newlist (cons (cons 62 color) newlist))
) ;end if
(setq ei (1+ ei))
) ;end while
(reverse newlist)
) ;end defun
(setq ob1 (entsel "\n选择要修改的任何文本:"))
(SETQ obn (car ob1) ptn (car (cdr ob1 )))
(setq obt (car (nentselp ptn)))
(setq oba (cdr (assoc 0 (entget obt))))
(if (or (= oba "TEXT")(= oba "MTEXT")(= oba "ATTRIB"))
(setq otxt (cdr (assoc 1 (entget obt))))
) ;end if
(if (= oba "ATTDEF")
(setq otxt (cdr (assoc 2 (entget obt))))
) ;end if
(if otxt
(progn
(setq
sty (cdr (assoc 7 (entget obt)))
lay (cdr (assoc 8 (entget obn)))
hig (cdr (assoc 40 (entget obt)))
wid (cdr (assoc 41 (entget obt)))
ang (cdr (assoc 50 (entget obt)))
) ;end setq
(if (or (= oba "TEXT")(= oba "MTEXT")(= oba "ATTRIB"))
(setq col (cdr (assoc 62 (entget obt))))
(setq col (cdr (assoc 62 (entget obn))))
) ;end if
(setq ang (* 180 (/ ang pi)))
(if (null col)(progn (setq cyn 0)(setq col 256))(setq cyn 1))
(setq style (style_get_all))
(setq layer (layer_get_all))
(setq styno (- (length style)(length (member sty style))))
(setq layno (- (length layer)(length (member lay layer))))
(setq dcl_id1 (load_dialog "文字修改.DCL"))
(if (not (new_dialog "文字修改" dcl_id1))(exit))
(set_color col)
(set_tile "text" otxt)
(set_tile "hig" (rtos hig 2 2))
(set_tile "wid" (rtos wid 2 2))
(set_tile "ang" (rtos ang 2 2))
(mode_tile "text" 2)
(map_keylist "sty" style)(set_tile "sty" (itoa styno))
(map_keylist "lay" layer)(set_tile "lay" (itoa layno))
(action_tile "text" "(setq txt $value)")
(action_tile "sty" "(setq styno (atoi $value))")
(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 \"\"))")
(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 \"\"))")
(action_tile "lay" "(setq layno (atoi $value))")
(action_tile "col" "(if (setq cnu (ACAD_ColorDlg col))(progn (setq col cnu)(set_color col)))")
(action_tile "ang" "(setq ang (distof $value))")
(action_tile "accept" "(done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")

(if (= 1 (start_dialog))
(if txt
(progn
(setq sty (nth styno style))
(setq lay (nth layno layer))
(setq ang (* (/ ang 180) pi))
(setq etlst (entget obt))
(if (= oba "ATTDEF")
(setq etlst (subst (cons 2 txt)(assoc 2 etlst) etlst))
(setq etlst (subst (cons 1 txt)(assoc 1 etlst) etlst))
) ;end if
(setq etlst (subst (cons 7 sty)(assoc 7 etlst) etlst))
(setq etlst (subst (cons 40 hig)(assoc 40 etlst) etlst))
(setq etlst (subst (cons 41 wid)(assoc 41 etlst) etlst))
(setq etlst (subst (cons 50 ang)(assoc 50 etlst) etlst))
(if (= 1 cyn)
(setq etlst (subst (cons 62 col)(assoc 62 etlst) etlst))
(if (= "MTEXT" oba)
(setq etlst (sub_mtext col etlst))
(setq etlst (cons (cons 62 col) etlst))
) ;end if
) ;end if
(entmod etlst)
(setq etlst (subst (cons 8 lay)(assoc 8 (entget obn)) (entget obn)))
(entmod etlst)
(entupd obt)
(entupd obn)
)
) ;end if
);end if
(if (= 11 (start_dialog))(Command "_help"))
) ;end progn
) ;end if
(setq *error* olderr)
(EF:UNDOEnd)
(princ)
) ;end defun

；；；；；；；；；；；；；；；；；；；；；；；；；；；；；

DCL：
//SUPERDDEDIT
文字修改: dialog {
label = "文字编辑...";
: boxed_radio_column {
label = "超级文字编辑...";
: edit_box { label= "文字:"; key = "text"; edit_width = 50; }
: row {
: popup_list {label="样式"; key = "sty"; edit_width = 13; fixed_width = true;}
: edit_box {label="高度"; key = "hig"; edit_width = 7; fixed_width = true;}
: edit_box {label="宽度"; key = "wid"; edit_width = 7; fixed_width = true;}
}
: row {
: popup_list {label="图层"; key = "lay"; edit_width = 13; fixed_width = true;}
: image_button {key = "col"; width= 4; aspect_ratio = 0.75; fixed_width = true;}
: text_part {key = "cnu"; width= 12;fixed_width = true; }
: edit_box {label="角度"; key = "ang"; edit_width = 7; fixed_width = true;}
}
spacer_1;
}
: row {
alignment = right;
: spacer {width = 1; fixed_width = true;}
ok_cancel;
}
errtile;
}

samshs

學習一下

aeo000000

有名无名块:程序里没看出来

tanle2020

试一试就知道咯

samshs

你爲什麽不做個LSP文件及DCL文件下載就可以啦

XIAOFEILONG

用了一下

觉得在画图的时候,这个程序的作用好象不大啊

azjmjsj

此程序是个好工具，方便实用，特别适合块文字，属性文字的编辑（适合处理外国图纸）。我修改了一下，增加了尺寸文字编辑功能。想用的到http://xbfr.ys168.com/下载
-->[CAD LISP实用工具]-->[超级文本编辑器]

tanle2020

可否把修改后的源码发到我邮箱，谢谢！

640244434@qq.com

Michael527

7楼的不厚道，把人家楼主的源码还给编译了

Michael527

嵌套块中的文字修改不了