文本超级编辑：支持标注、文字、块内文字修改版本
本帖最后由 jun353835273 于 2023-7-28 22:18 编辑原贴地址http://bbs.mjtd.com/thread-187014-1-1.html
由于原贴天正单行文字的不支持，花了点时间更新此代码
目前天正的对象颜色及对象宽度（天正文字没有宽度信息）没有支持，其他的测试基本么有问题
主要修改；
1、天正不支持entmod更改组码，更新就卡死，需要用VLA的方法。
2、天正角度为度和cad文字修改时的弧度单位不一样。
(Vlax-put obj_tch 'TextStylesty );改样式
(Vlax-put obj_tch 'Heighthig ) ;改高度
(Vlax-put obj_tch 'Layerlay ) ;改图层
(Vlax-put obj_tch 'Rotationtch_ang ) ;改旋转方向
;acActiveViewport-仅重新生成活动视口,acAllViewports-重新生成文档上的所有视口。
(vla-regen(vla-get-ActiveDocument (vlax-get-acad-object))AcAllViewPorts)
存在问题；
外部参照还有待完善，不过外部参照搞起来比较麻烦，比如修改文字高度，要修改原始参照文件的源文件才可以，希望我这是抛砖引玉，高人来不断完善。
;*文本超级编辑_增加天正单行文字命令FD
;;; 自定义UnDo范围
;;(princ "\n修改文字已加载,启动命令ed.")
;;原作者不详
;;2023年1月19日更改by 半途中
(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:fd (/ dcl_id1 oba ob1obn obt ptn
otxt txt sty styno laycyn laynohig
wid ang col cnu etlststylelayerobj_tchtch_ang
)
(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 layernil ; 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选择要修改的任何文本:"))
(SETQobn (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")
(= oba "TCH_TEXT")
)
(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 obt)))
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")
(= oba "TCH_TEXT")
)
(setq col (cdr (assoc 62 (entget obt))))
(setq col (cdr (assoc 62 (entget obn))))
); end if
(setq tch_ang ang)
;(alert (rtos tch_ang 2 2 ))
(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 dclname
(cond
((setq tempname (vl-filename-mktemp "tt-dcl-tmp.dcl")
filen (open tempname "w")
)
(foreach stream
'("\n"
"文字修改:dialog {\n"
"label = \"文字编辑...\";\n"
": boxed_radio_column {\n"
" label = \"超级文字编辑...\";\n"
" : edit_box {\n"
" label= \"文字:\";\n"
" key = \"text\";\n"
" edit_width = 50;\n"
" allow_accept = true;\n"
" }\n"
" : row {\n"
" : popup_list {\n"
" label=\"样式\";\n"
" key = \"sty\";\n"
" edit_width = 13;\n"
" fixed_width = true;\n"
" }\n"
" : edit_box {\n"
" label=\"高度\";\n"
" key = \"hig\";\n"
" edit_width = 7;\n"
" fixed_width = true;\n"
" }\n"
" : edit_box {\n"
" label=\"宽度\";\n"
" key = \"wid\";\n"
" edit_width = 7;\n"
" fixed_width = true;\n"
" }\n"
" }\n"
" : row {\n"
" : popup_list {\n"
" label=\"图层\";\n"
" key = \"lay\";\n"
" edit_width = 13;\n"
" fixed_width = true;\n"
" }\n"
" : image_button {\n"
" key = \"col\";\n"
" width= 4;\n"
" aspect_ratio = 0.75;\n"
" fixed_width = true;\n"
" }\n"
" : text_part {\n"
" key = \"cnu\";\n"
" width= 12;\n"
" fixed_width = true;\n"
" }\n"
" : edit_box {\n"
" label=\"角度\";\n"
" key = \"ang\";\n"
" edit_width = 7;\n"
" fixed_width = true;\n"
" }\n"
" }\n"
" spacer_1;\n"
"}\n"
": row {\n"
" alignment = right;\n"
" : spacer {\n"
" width = 1;\n"
" fixed_width = true;\n"
" }\n"
" ok_cancel;\n"
"}\n"
"errtile;\n"
"}\n"
)
(princ stream filen)
)
(close filen)
tempname
)
)
)
(setq dcl_id1 (load_dialog dclname))
(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))
(if (not wid)
(setq wid 1)
)
(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 aabb txt)
;hig 字体高度
;COL颜色
(setq sty (nth styno style));字体样式
(setq lay (nth layno layer));图层
(setq tch_ang ang) ;天正为度
(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
;TCH_TEXT天正文字
(if(= oba "TCH_TEXT")
(progn
(and (setq obj_tch (vlax-ename->vla-object obt))
(vlax-put-property obj_tch 'TEXT txt)
)
(Vlax-put obj_tch 'TextStylesty );改样式
(Vlax-put obj_tch 'Heighthig ) ;改高度
(Vlax-put obj_tch 'Layerlay ) ;改图层
(Vlax-put obj_tch 'Rotationtch_ang ) ;改旋转方向
;acActiveViewport-仅重新生成活动视口,acAllViewports-重新生成文档上的所有视口。
(vla-regen(vla-get-ActiveDocument (vlax-get-acad-object))AcAllViewPorts)
)
(progn
(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
)
)
(setq etlst(subst
(cons 8 lay)
(assoc 8 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)
(entupd obt)
(entupd obn)
)
) ; end TCH_TEXT
)
) ; end if
) ; end if
(if (= 11 (start_dialog))
(Command "_help")
)
) ; end progn
) ; end if
(setq *error* olderr)
(EF:UNDOEnd)
(princ)
(unload_dialog dcl_id1)
(vl-file-delete dclname)
)
;;; end defun
jun353835273 发表于 2023-7-20 22:21
单步调试一下看看
对不起哈，我不太会。我测试了两台CAD2022 2024 天正T20V9的情况下。成功的概率很小。都是 清一色的提示：选择要修改的任何文本：T
等我再学学Lisp再调试一下。大佬您的这个思路和代码真的非常好！ photo_cup 发表于 2023-7-4 19:45
可以麻烦帮改下么，谢谢
标注移动了变回原值的你提供个测试图，有空我看看。
关于框选实现起来有难度这个是通过entsel 单个选择的，框选整个程序结构都要改变。 我不太会。我测试了两台CAD2022 2024 天正T20V9的情况下。成功的概率很小。都是 清一色的提示：选择要修改的任何文本：T
等我再学学Lisp再调试一下。大佬您的这个思路和代码真的非常好！ 感谢楼主共享资源！ 感谢楼主分享！{:1_1:} 谢谢楼主分享 谢楼主共享好程序，回复表示感谢 谢谢分享！！！ 谢谢分享！！！！ 超级牛逼的程序，谢谢楼主分享啊。正需要的。 感谢楼主分享！:lol 多谢楼主分享。要是不需要面板待修改的文字和用来修改的内容能在命令行输入就更好了