有没有这样的LISP，启用后改过的字自动变颜色？

wanghangshun

这是一个有用的功能，学习先。

amen1981628

这个要顶一下

fullhotdog1

这个好    顶

haiyunzhou

学习了 非常感谢

langjs

我也凑凑热闹，双击单行文本修改变色

;;; 　　　　《单行文本书写和修改》v2.0
;;; ================================================
;;; 功能：文本程序含双击反应器，对单行文本有两个功能：
;;;       1、书写单行文本，命令：tr
;;;       2、修改单行文本，命令：tx 或者双击单行文本
;;;       3、修改过的文本颜色变色，可恢复。
;;; 作者：langjs qq:59509100　   日期:2012年03月10日
;;; ================================================
;;;
;;; ===================================================
;;; 下面程序定义双击反应器
(princ "\n写单行文本：TR，修改单行文本：TX或双击")
(vl-load-com)
(if (member "acdblclkedit.arx" (arx))
  (arxunload "acdblclkedit.arx" nil)
)
(or
  *dblclkcirclereactor*
  (setq *dblclkcirclereactor* (vlr-mouse-reactor nil' ((:vlr-begindoubleclick . dblclkedit))))
)
;;; 回调函数
(defun dblclkedit (reactorobject point / b c doc owner p)
  (setvar "cmdecho" 0)         ; 关闭命令响应
  (if (setq owner (nentselp (setq p (trans (car point) 0 1)))) ; 指定点来选择对象
    (progn
      (if (> (length owner) 2)
(setq ent (last (last owner)))
(setq ent (car owner))
      )
      (sssetfirst nil)
      (redraw ent 4)
      (setq b (cdr (assoc 0 (entget ent)))
     c (cdr (assoc 66 (entget ent)))
     doc (vlax-get (vlax-get-acad-object) "activedocument")
      )
      (cond
((= b "TEXT")
   (vla-sendcommand doc "showwzbz ")
)
((= b "MTEXT")
   (vla-sendcommand doc "_mtedit ")
   (princ "\n多行文本")
)
((= b "ATTRIB")
   (vla-sendcommand doc "_eattedit ")
   (princ "\n属性块")
)
((= b "INSERT")
   (if (= c 1)
     (progn
       (vla-sendcommand doc "_eattedit ")
       (princ "\n属性块")
     )
     (progn
       (vla-sendcommand doc "_bedit ")
       (princ "\n块")
     )
   )
)
((= b "HATCH")
   (vla-sendcommand doc "_hatchedit ")
   (princ "\n剖面")
)
(t
   (vla-sendcommand doc "_properties ")
   (princ "\n其它")
)
      )
      (princ)
    )
  )
)
(defun c:showwzbz ()
  (showwzbz ent)
  (princ)
)
;;; ===================================================
;;; 下面程序是修改单行文本属性
(defun showwzbz (ent / bb cc dcl_re dclname dd ee ent1 file i lst01 lst02 lst03 next t1 t40 t41 t50 t51 tls) ; 显对话框
  (while ent
    (setq bb 0
   ee '()
    )
    (setq lst01 '("左对齐" "中间对齐"
    "右对齐" "高度自适应"
    "中心对齐" "宽度自适应"
   )
    )
    (setq lst02 '("基线对齐" "顶对齐"
    "中间对齐" "底对齐"
   )
    )
    (setq lst03 '()
   next (tblnext "style" t)
    )
    (while (setq lst03 (cons (cdr (assoc 2 next)) lst03)
   next (tblnext "style" nil)
    )
    )
    (setq lst03 (reverse lst03)
   ent (entget ent)
    )
    (setq ent1 ent
   t1 (cdr (assoc 1 ent))
   t40 (rtos (cdr (assoc 40 ent)) 2)
   t41 (rtos (cdr (assoc 41 ent)) 2)
   t50 (rtos (/ (* 180 (cdr (assoc 50 ent))) pi) 2)
   t51 (rtos (/ (* 180 (cdr (assoc 51 ent))) pi) 2)
   tls (cdr (assoc 72 ent))
    )
    (cond
      ((= tls 0)
(setq lst01 (cons "左对齐" (vl-remove "左对齐" lst01)))
      )
      ((= tls 1)
(setq lst01 (cons "中间对齐" (vl-remove "中间对齐" lst01)))
      )
      ((= tls 2)
(setq lst01 (cons "右对齐" (vl-remove "右对齐" lst01)))
      )
      ((= tls 3)
(setq lst01 (cons "高度自适应" (vl-remove "高度自适应" lst01)))
      )
      ((= tls 4)
(setq lst01 (cons "中心对齐" (vl-remove "中心对齐" lst01)))
      )
      ((= tls 5)
(setq lst01 (cons "宽度自适应" (vl-remove "宽度自适应" lst01)))
      )
      (t
(princ)
      )
    )
    (setq tls (cdr (assoc 73 ent)))
    (cond
      ((= tls 0)
(setq lst02 (cons "基线对齐" (vl-remove "基线对齐" lst02)))
      )
      ((= tls 1)
(setq lst02 (cons "顶对齐" (vl-remove "顶对齐" lst02)))
      )
      ((= tls 2)
(setq lst02 (cons "中间对齐" (vl-remove "中间对齐" lst02)))
      )
      ((= tls 3)
(setq lst02 (cons "底对齐" (vl-remove "底对齐" lst02)))
      )
      (t
(princ)
      )
    )
    (setq tls (cdr (assoc 7 ent))
   lst03 (vl-remove tls lst03)
   lst03 (cons tls lst03)
   dclname (wzbz1001)
   dcl_re (load_dialog dclname)
    )
    (if (not (new_dialog "wzbz1" dcl_re))
      (exit)
    )
    (set_tile "e01" t1)
    (set_tile "e02" t40)
    (set_tile "e03" t41)
    (set_tile "e04" t50)
    (set_tile "e05" t51)
    (setq tls (cdr (assoc 71 ent)))
    (cond
      ((= tls 2)
(set_tile "e09" "1")
(setq cc "1"
       dd "0"
)
      )
      ((= tls 4)
(set_tile "e10" "1")
(setq cc "0"
       dd "1"
)
      )
      ((= tls 6)
(setq cc "1"
       dd "1"
)
(set_tile "e09" "1")
(set_tile "e10" "1")
      )
      (t
(setq cc "0"
       dd "0"
)
      )
    )
    (show_list "e06" lst01)
    (show_list "e07" lst02)
    (show_list "e08" lst03)
    (action_tile "e06" "(setq lst01 (wzbz0001  $value   lst01))  ") ; 水平对齐
    (action_tile "e07" "(setq lst02 (wzbz0002  $value   lst02))") ; 垂直对齐
    (action_tile "e08" "(setq lst03 (wzbz0003  $value   lst03))  ") ; 文字式样
    (action_tile "e09" "(setq cc (wzbz0004 $value ))  ") ; 前后颠倒
    (action_tile "e10" "(setq dd (wzbz0004  $value ))  ") ; 上下翻转
    (action_tile "e11" "(setq ee (wzbz0005  $value ))  ") ; 保存设置
    (action_tile "e00" "(wzbz0000 ent ent1)(setq dcl_pt (done_dialog 1))") ; 确定
    (action_tile "e100" "(setq dcl_pt (done_dialog 2))") ; 颜色复原
    (setq bb (start_dialog))
    (unload_dialog dcl_re)
    (vl-file-delete dclname)
    (if (= (length ee) 9)
      (progn
(setq file (open "c:\\WINDOWS\\temp\\WZBZ.ini" "W"))
(setq i 0)
(while (< i (length ee))
   (write-line (nth i ee) file)
   (setq i (+ i 1))
)
(close file)
      )
    )
    (if (= bb 2)
      (wzbz1000)
    )
    (if (= bb 1)
      (setq ent (car (entsel "\n请选择要修改的文字：")))
      (vl-exit-with-error "")
    )
  )
  (princ)
)
(defun wzbz0001 (value lst / a)
  (setq a (nth (atoi value) lst)
lst (cons a (vl-remove a lst))
  )
  (show_list "e06" lst)
  lst
)
(defun wzbz0002 (value lst / a)
  (setq a (nth (atoi value) lst)
lst (cons a (vl-remove a lst))
  )
  (show_list "e07" lst)
  lst
)
(defun wzbz0003 (value lst / a)
  (setq a (nth (atoi value) lst)
lst (cons a (vl-remove a lst))
  )
  (show_list "e08" lst)
  lst
)
(defun wzbz0004 (value)
  value
)
(defun wzbz0005 (value)
  (if (= value "1")
    (progn
      (setq ee '())
      (setq ee (cons (get_tile "e02") ee))
      (setq ee (cons (get_tile "e03") ee))
      (setq ee (cons (get_tile "e04") ee))
      (setq ee (cons (get_tile "e05") ee))
      (setq ee (cons (car lst01) ee))
      (setq ee (cons (car lst02) ee))
      (setq ee (cons (car lst03) ee))
      (setq ee (cons cc ee))
      (setq ee (cons dd ee))
    )
    (setq ee '())
  )
  (reverse ee)
)
(defun wzbz0000 (ent ent1 / t1 t40 t41 t50 t51 t7 t71 t72 t73 tls)
  (setq t1 (get_tile "e01")
ent (entmodd 1 t1 ent)
t40 (atof (get_tile "e02"))
ent (entmodd 40 t40 ent)
t41 (atof (get_tile "e03"))
ent (entmodd 41 t41 ent)
t50 (/ (* (atof (get_tile "e04")) pi) 180)
ent (entmodd 50 t50 ent)
t51 (/ (* (atof (get_tile "e05")) pi) 180)
ent (entmodd 51 t51 ent)
tls (car lst01)
  )
  (cond
    ((= tls "左对齐")
      (setq t72 0)
    )
    ((= tls "中间对齐")
      (setq t72 1)
    )
    ((= tls "右对齐")
      (setq t72 2)
    )
    ((= tls "高度自适应")
      (setq t72 3)
    )
    ((= tls "中心对齐")
      (setq t72 4)
    )
    ((= tls "宽度自适应")
      (setq t72 5)
    )
    (t
      (princ)
    )
  )
  (setq ent (entmodd 72 t72 ent))
  (setq tls (car lst02))
  (cond
    ((= tls "基线对齐")
      (setq t73 0)
    )
    ((= tls "顶对齐")
      (setq t73 1)
    )
    ((= tls "中间对齐")
      (setq t73 2)
    )
    ((= tls "底对齐")
      (setq t73 3)
    )
    (t
      (princ)
    )
  )
  (setq ent (entmodd 73 t73 ent)
t7 (car lst03)
ent (entmodd 7 t7 ent)
  )
  (cond
    ((and
       (= cc "1")
       (= dd "0")
     )
      (setq t71 2)
    )
    ((and
       (= cc "0")
       (= dd "1")
     )
      (setq t71 4)
    )
    ((and
       (= cc "1")
       (= dd "1")
     )
      (setq t71 6)
    )
    ((and
       (= cc "0")
       (= dd "0")
     )
      (setq t71 0)
    )
  )
  (setq ent (entmodd 71 t71 ent))
  (if (/= (assoc 62 ent1) nil)        ; 修改字体变红
    (setq ent (subst
  (cons 62 1)
  (assoc 62 ent)
  ent
       )
    )
    (setq ent (cons (cons 62 1) ent))
  )
  (entmod ent)
)
(defun entmodd (ff new ent)
  (setq ent (subst
       (cons ff new)
       (assoc ff ent)
       ent
     )
  )
  ent
)
(defun show_list (key newlist)
  (start_list key)
  (mapcar
    'add_list
    newlist
  )
  (end_list)
)
(defun c:tx (/ ent)
  (setvar "cmdecho" 0)         ; 关闭命令响应
  (setq ent (car (entsel "\n请选择要修改的文字：")))
  (showwzbz ent)
  (princ)
)
;;; ===================================================
;;; 下面程序是书写单行文本属性
(defun c:tr (/ bb cc dcl_re dclname dd ee ent file i lst01 lst02 lst03 next pt t1 t40 t41 t50 t51 t7 t71 t71s t72 t72s t73 t73s)
  (setvar "cmdecho" 0)         ; 关闭命令响应
  (setq lst01 '("左对齐" "中间对齐"
  "右对齐" "高度自适应"
  "中心对齐" "宽度自适应"
)
  )
  (setq lst02 '("基线对齐" "顶对齐"
  "中间对齐" "底对齐"
)
  )
  (setq lst03 '()
next (tblnext "style" t)
  )
  (while (setq lst03 (cons (cdr (assoc 2 next)) lst03)
        next (tblnext "style" nil)
  )
  )
  (setq lst03 (reverse lst03)
t40 "3"
t41 "0.7"
t50 "0"
t51 "0"
t72s "左对齐"
t73s "基线对齐"
t71s (car lst03)
cc "0"
dd "0"
file (open "c:\\WINDOWS\\temp\\WZBZ.ini" "r")
t40 (read-line file)
t41 (read-line file)
t50 (read-line file)
t51 (read-line file)
t72s (read-line file)
t73s (read-line file)
t71s (read-line file)
cc (read-line file)
dd (read-line file)
  )
  (close file)
  (setq lst01 (vl-remove t72s lst01)
lst01 (cons t72s lst01)
lst02 (vl-remove t73s lst02)
lst02 (cons t73s lst02)
  )
  (if (member t71s lst03)
    (setq lst03 (vl-remove t71s lst03)
   lst03 (cons t71s lst03)
    )
  )
  (setq dclname (wzbz1001)
dcl_re (load_dialog dclname)
  )
  (if (not (new_dialog "wzbz1" dcl_re))
    (exit)
  )
  (set_tile "e02" t40)
  (set_tile "e03" t41)
  (set_tile "e04" t50)
  (set_tile "e05" t51)
  (show_list "e06" lst01)
  (show_list "e07" lst02)
  (show_list "e08" lst03)
  (cond
    ((and
       (= cc "1")
       (= dd "0")
     )
      (set_tile "e09" "1")
    )
    ((and
       (= cc "0")
       (= dd "1")
     )
      (set_tile "e10" "1")
    )
    ((and
       (= cc "1")
       (= dd "1")
     )
      (set_tile "e09" "1")
      (set_tile "e10" "1")
    )
    ((and
       (= cc "0")
       (= dd "0")
     )
      (set_tile "e09" "0")
      (set_tile "e10" "0")
    )
  )
  (action_tile "e06" "(setq lst01 (wzbz0001  $value   lst01))  ") ; 水平对齐
  (action_tile "e07" "(setq lst02 (wzbz0002  $value   lst02))") ; 垂直对齐
  (action_tile "e08" "(setq lst03 (wzbz0003  $value   lst03))  ") ; 文字式样
  (action_tile "e09" "(setq cc (wzbz0004 $value ))  ") ; 前后颠倒
  (action_tile "e10" "(setq dd (wzbz0004  $value ))  ") ; 上下翻转
  (action_tile "e11" "(setq ee (wzbz0005  $value ))  ") ; 保存设置
  (action_tile "e00" "(wzbz1100  )(setq dcl_pt (done_dialog 2))") ; 确定
  (action_tile "e100" "(setq dcl_pt (done_dialog 3))") ; 颜色复原
  (setq bb (start_dialog))
  (unload_dialog dcl_re)
  (vl-file-delete dclname)
  (if (= (length ee) 9)
    (progn
      (setq file (open "c:\\WINDOWS\\temp\\WZBZ.ini" "W"))
      (setq i 0)
      (while (< i (length ee))
(write-line (nth i ee) file)
(setq i (+ i 1))
      )
      (close file)
    )
  )
  (if (and
(= bb 2)
(/= t1 "")
      )
    (progn
      (setq pt (getpoint "\n请选择文字标注的起点："))
      (command "-TEXT" pt t40 t50 t1)
      (setq ent (entget (entlast))
     ent (entmodd 41 t41 ent)
     ent (entmodd 51 t51 ent)
     ent (entmodd 72 t72 ent)
     ent (entmodd 73 t73 ent)
     ent (entmodd 71 t71 ent)
     ent (entmodd 7 t7 ent)
      )
      (entmod ent)
    )
    (princ)
  )
  (if (= bb 3)
    (wzbz1000)
  )
  (princ)
)
(defun wzbz1100 (/ cc dd tls)
  (setq t1 (get_tile "e01")
t40 (atof (get_tile "e02"))
t41 (atof (get_tile "e03"))
t50 (atof (get_tile "e04"))
t51 (/ (* (atof (get_tile "e05")) pi) 180)
tls (car lst01)
  )
  (cond
    ((= tls "左对齐")
      (setq t72 0)
    )
    ((= tls "中间对齐")
      (setq t72 1)
    )
    ((= tls "右对齐")
      (setq t72 2)
    )
    ((= tls "高度自适应")
      (setq t72 3)
    )
    ((= tls "中心对齐")
      (setq t72 4)
    )
    ((= tls "宽度自适应")
      (setq t72 5)
    )
    (t
      (princ)
    )
  )
  (setq tls (car lst02))
  (cond
    ((= tls "基线对齐")
      (setq t73 0)
    )
    ((= tls "顶对齐")
      (setq t73 1)
    )
    ((= tls "中间对齐")
      (setq t73 2)
    )
    ((= tls "底对齐")
      (setq t73 3)
    )
    (t
      (princ)
    )
  )
  (setq t7 (car lst03)
cc (get_tile "e09")
dd (get_tile "e10")
  )
  (cond
    ((and
       (= cc "1")
       (= dd "0")
     )
      (setq t71 2)
    )
    ((and
       (= cc "0")
       (= dd "1")
     )
      (setq t71 4)
    )
    ((and
       (= cc "1")
       (= dd "1")
     )
      (setq t71 6)
    )
    ((and
       (= cc "0")
       (= dd "0")
     )
      (setq t71 0)
    )
  )
)
(defun wzbz1000 (/ ent i ss)
  (if (setq ss (ssget "X" (list '(0 . "TEXT") (cons 62 1))))
    (repeat (setq i (sslength ss))
      (setq obj (vlax-ename->vla-object (ssname ss (setq i (1- i)))))
      (vla-put-color obj 256)
    )
  )
  (princ)
)
(defun wzbz1001 (/ filen stream tempname)
  (cond
    ((setq tempname (vl-filename-mktemp "wzbz.dcl")
    filen (open tempname "w")
     )
      (foreach stream '("\n" "wzbz1:dialog {\n"
  "   label = \"文字标注\" ;\n" "     :column {\n"
  "         :boxed_column {\n"
  "             :row { :edit_box { label = \"标注内容\" ;  key = \"e01\" ; edit_width = 42 ;  height = 1.4 ; } } spacer_1;\n"
  "             :row { :edit_box { label = \"文字高度\" ;  key = \"e02\" ;   edit_width = 10 ;  }   spacer_1;\n"
  "                 :popup_list {  label = \"水平对齐方式\" ;   key = \"e06\" ;   edit_width = 10 ;   }  }\n"
  "             :row {  :edit_box { label = \"宽度比例\" ;    key = \"e03\" ;   edit_width = 10 ;   }   spacer_1;\n"
  "                 :popup_list {   label = \"垂直对齐方式\" ;   key = \"e07\" ;  edit_width = 10 ;  }   }\n"
  "             :row {  :edit_box {  label = \"旋转角度\" ;  key = \"e04\" ;    edit_width = 10 ;  }  spacer_1;\n"
  "                 :popup_list {  label = \"标注文字式样\" ;   key = \"e08\" ;  edit_width = 10 ;   }  }\n"
  "             :row {  :edit_box {   label = \"倾斜角度\" ;    key = \"e05\" ;    edit_width = 10 ;    } spacer_1;\n"
  "                 :toggle{   label = \"前后颠倒\" ;   key = \"e09\" ;  }    spacer_1;    spacer_1;\n"
  "                 :toggle{  label = \"上下翻转\" ;     key = \"e10\" ;   }  }  }\n"
  "           :row {  spacer_1;  spacer_1;   spacer_1;  spacer_1;\n"
  "             :toggle{ label = \"保留设置\" ;     key = \"e11\" ;   }\n"
  "             :button {  label = \"颜色复原\" ;   key = \"e100\" ;  }\n"
  "             :button {  label = \"确定\" ;   key = \"e00\" ;   is_default = true ;    }\n"
  "             cancel_button;  spacer_1;  spacer_1;   spacer_1;  spacer_1;  }\n"
  "     }\n" " }\n"
)
(princ stream filen)
      )
      (close filen)
      tempname
    )
  )
)

puzb2001

langjs 兄，perfect

hhhlike

学习一下，很有用的功能

wangph

Gu_xl 发表于 2012-2-29 18:53
;;文字变动监视示例代码
**** 本内容被作者隐藏 ****

为什么非要先回复才能看到内容呢

puzb2001

没有限制吧

成仔

感谢楼主分享