炒冷饭：字编辑器(改过变色，不改不变）
本帖最后由 yjr111 于 2012-3-2 22:13 编辑flytoday发给我的网上的程序，今天有空完善了一下，一次设定即可，中途可变更修改颜色
edit:dialog
{
label="文字编辑";
:edit_box
{
label="文字:";
key="edit";
edit_width=40;
//height=2;
//fixed_height=true;
allow_accept=true;
}
:row
{
:text{value="修改颜色:";width=5;}
:image_button{height=2;key="tucengcolor";width=4;}
ok_cancel;
}
spacer;
}(defun newerr()
(setq *error* olderr esel nil edata nil d nil new nil do nil ss nil name nil)
(command "undo" "e")
(princ)
)
(defun c:ue(/ esel edata enme id new do ss name)
(setq olderr *error* *error* newerr )
(if (not colorname )(setq colorname 1)colorname)
(gc)
(setvar "cmdecho" 0)
(command "undo" "be")
(VL-LOAD-COM)
(setq AcadObject(vlax-get-acad-object)
AcadDocument(vla-get-ActiveDocument Acadobject)
mSpace(vla-get-ModelSpace Acaddocument)
)
(defun getdata14(color / ccc);;;定义获取acad标准颜色函数
(setq ccc(acad_colordlg color t))
(if (not ccc)(setq ccc color))
ccc
)
(defun c_img(key color);;;定义初始化颜色图像按钮函数
(if color
(progn
(start_image key)
(fill_image 0 0 (dimx_tile key)(dimy_tile key)color)
(end_image)
)
)
)
(setq esel (nentsel "\n选择文字"))
(setq edata (entget (car esel)))
(setq oldwenzi (cdr(assoc 1 edata)))
(if
(and
(> (length esel) 2)
(= (cdr (assoc 0 (entget (car esel)))) "MTEXT")
(= (cdr (assoc 0 (entget (car (last esel))))) "DIMENSION")
)
(setq enme (car (last esel)) edata (entget enme))
)
(cond
(
(or
(= (cdr (assoc 0 edata)) "TEXT")
(= (cdr (assoc 0 edata)) "MTEXT")
(= (cdr (assoc 0 edata)) "DIMENSION")
(= (cdr (assoc 0 edata)) "ATTRIB")
(= (cdr (assoc 0 edata)) "ATTDEF")
)
(if (> (setq id (load_dialog "ue.dcl")) 0)
(if (new_dialog "edit" id)
(progn
(cond
(
(= (cdr (assoc 0 edata)) "DIMENSION")
(set_tile "edit" (vl-string-subst"" "\\A1;" (cdr (assoc 1 (entget (car esel))))))
(set_tile "error" "尺寸文字")
)
(
(and (> (length esel) 2)(= (cdr (assoc 0 (entget (car (last esel))))) "INSERT"))
(set_tile "edit" (cdr (assoc 1 edata)))
(set_tile "error" "块中文字")
)
(
(and (= (length esel) 2)(= (cdr (assoc 0 (entget (car esel)))) "TEXT"))
(set_tile "edit" (cdr (assoc 1 edata)))
(set_tile "error" "普通文字")
)
(
(and (= (length esel) 2)(= (cdr (assoc 0 (entget (car esel)))) "MTEXT"))
(set_tile "edit" (cdr (assoc 1 edata)))
(set_tile "error" "段落文字")
)
(
(and (= (length esel) 2)(= (cdr (assoc 0 (entget (car esel)))) "ATTRIB"))
(set_tile "edit" (cdr (assoc 1 edata)))
(set_tile "error" "属性文字")
)
(
(and (= (length esel) 2)(= (cdr (assoc 0 (entget (car esel)))) "ATTDEF"))
(set_tile "edit" (cdr (assoc 2 edata)))
(set_tile "error" "属性定义")
)
)
(mode_tile "edit" 2)
(c_img "tucengcolor" colorname)
(action_tile "edit" "(setq new $value)")
(set_tile "tucengcolor" (strcat" "(itoa colorname)))
(action_tile "tucengcolor" "(setq colorname(getdata14 colorname))(c_img $key colorname)");;;;图层颜色按钮的动作
(action_tile "accept" "(setq result T)(done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
(start_dialog)
)
)
)
(unload_dialog id)
(if result
(progn
(if (= (cdr (assoc 0 (entget (car esel)))) "ATTDEF")
(setq edata (subst (cons 2 new) (assoc 2 edata) edata))
(setq edata (subst (cons 1 new) (assoc 1 edata) edata))
)
(entmod edata)
(if (and (> (length esel) 2)(= (cdr (assoc 0 (entget (car (last esel))))) "INSERT"))
(progn
(setq name (cdr (assoc 2 (entget (car (last esel))))))
(setq ss (ssget "x" '((0 . "insert"))) n 0)
(repeat (sslength ss)
(setq esel (ssname ss n) n (1+ n))
(if (= (cdr (assoc 2 (entget esel))) name)
(progn
(entupd esel)
)
)
)
)
(progn
(entupd (car esel))
)
)
)
)
)
(T (princ "\n不是文字"))
)
(setq newwenzi (cdr(assoc 1 edata)))
(if (/= oldwenzi newwenzi)
(progn
(vla-put-color (vlax-ename->vla-object (car esel)) colorname)
;(vla-Regen AcadDocument :vlax-true)
(entupd (car esel))
)
)
(newerr)
(princ)
)
好程序，美中不足的是速度有点慢 一直觉得AutoCAD在保留修改过程这一点上很不好,实践中不得不使用各种方法来纪录各种修改过程和某些需要纪录的内容,注释...
怎么就不能给对象们增加一个 Comment 属性呢? 目前只能用 Hyperlink 来暂时替代这个需求.
我希望能在光标Rollover对象时,能自动显示其 Comment 提示文字(如:何时修改的,为何修改的,其表示什么...),就象其他的 Layer,Color属性那样. 好程序，美中不足的是我没用得起来，不知道别的兄弟测试的结果如何？ puzb2001 发表于 2012-3-2 15:28 static/image/common/back.gif
好程序，美中不足的是我没用得起来，不知道别的兄弟测试的结果如何？
具体是放到什么路径下 大侠可以告诉一下吗？ 楼主 这个怎么用呀dcl 文件又怎么弄呢？能具体点吗 本帖最后由 429014673 于 2012-3-2 17:47 编辑
如果每次都没有REGEN就好了。。。。图档大就不好了。。。。块文字好像不变色 本帖最后由 puzb2001 于 2012-3-2 22:13 编辑
试试把LTSCALE调高点看看？是不是速度就快了
yjr111 兄：“下载fas测试一下吧，感觉不慢”。正解，谢谢
很有意思的文字编辑，比过去r14下面的ddedit还要强大
页:
[1]
2