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

tanle2020 · 发表于 2009-5-25 13:09:47

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

转发一好用程序，可修改任何文字，唯独不能修改尺寸文字，望原创作者或各位高手能修改一下。
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;
}

ppvspp1983 · 发表于 2009-6-6 12:06:04

辛苦了，真是要好好学习

gaqohuibb · 发表于 2009-6-19 17:52:22

应即通常是做不到了，我倒是急着用，根本下载不了，等到攒够了积分和金钱，活早就干完了

TIANJIE · 发表于 2009-7-4 17:54:49

哎~
积分是关键

Michael527 · 发表于 2017-6-13 21:52:12

修改完的文字没反应

qq1254582201 · 发表于 2019-7-16 12:49:43

学习了，这个看着不错的
来自: 微社区

账号		自动登录	找回密码
密码			立即注册

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

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子