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

puzb2001 · 发表于 2012-2-28 19:53:22

本帖最后由 puzb2001 于 2012-3-6 10:29 编辑

如题，答案详8楼9楼。根据老大们的思路，写了一个简单的代码详31楼，各位老大能不能看看31楼的问题？谢谢

逍遥天下 · 发表于 2019-1-13 00:36:06

Gu_xl 发表于 2012-3-1 09:56
示例代码中：tt命令启动文字修改监视，tt1命令可以查看修改的文字（文字变红），tt2命令关闭文字监视，文 ...

如何保存在字典里，老大

↘觉醒 · 发表于 2019-1-13 16:46:09

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

牛逼的程序

37902505 · 发表于 2021-1-18 14:29:03

真是不错的插件啊！谢谢提供！

langjs · 发表于 2012-2-28 20:24:44

这个问题逻辑有问题，不可能有这样的程序

puzb2001 · 发表于 2012-2-29 08:34:08

本帖最后由 puzb2001 于 2012-2-29 08:54 编辑

为什么不可能？楼上的请看如下程序，不过是VBA的程序而已,使用时放到搜索文件夹，工具-宏-VBA管理器

lrd1861 · 发表于 2012-2-29 13:15:03

这个确实有

langjs · 发表于 2012-2-29 14:37:41

看错了，我还以为是"启动"CAD呢，原来是“启动lisp”。程序一般都是叫“运行”的

yjr111 · 发表于 2012-2-29 15:04:38

这个好像不复杂吧

puzb2001 · 发表于 2012-2-29 15:36:10

lrd1861 兄，yjr111 兄，langjs 兄，或各位大侠能不能弄一个共享一下啦？谢谢

hao3ren · 发表于 2012-2-29 16:00:06

;;文本编辑扩展工具，文本修改后变换颜色显示。可以设置ddedit命令修改后文本
;;的颜色，默认为当前系统颜色号加一，确认不修改为修改文本颜色号加一。
;;作者：南京市市政设计研究院嵇龙(ll_j@21cn.com)
;; 025－3283626
(defun ett_ct()
(initget "C ")
(setq s0 (entsel "\n设置颜色C / 选取文本:"))
(cond
( (= s0 "C") (ett_col))
( (= s0 "") nil)
( (and (= (type s0) 'LIST) (= (cdr (assoc 0 (entget (car s0)))) "TEXT"))
(redraw (setq sn (car s0)) 3)
(setq s1 (entget sn)
n1 (cdr (assoc 1 s1))
)
(command "_.DDEDIT" sn "")
(entupd sn)
(if (/= n1 (cdr (assoc 1 (entget sn))))
(progn
(setq s1 (entget sn))
(if (/= (assoc 62 s1) nil)
(setq s1 (subst (cons 62 c2) (assoc 62 s1) s1))
(setq s1 (cons (cons 62 c2) s1))
)
(entmod s1)
(redraw sn 1)
)
(progn
(setq s1 (entget sn) c3(+ c2 1))
(if (= c3 257) (setq c3 1))
(if (/= (assoc 62 s1) nil)
(setq s1 (subst (cons 62 c3) (assoc 62 s1) s1))
(setq s1 (cons (cons 62 c3) s1))
)
(entmod s1)
(redraw sn 1)
)
)
(setq sn nil)
(ett_ct)
)
(t (ett_ct))
)
)
(defun ett_col()
(setq c1 c2)
(setq c2 (acad_colordlg c2))
(if (= c2 nil) (setq c2 c1))
(ett_ct)
)
(defun c:ett(/ sn s0 s1 c1 c2 c3 n1)
(setq c1 (getvar "CECOLOR"))
(if (or (= c1 "BYLAYER") (= c1 "BYBLOCK"))
(setq c1 1)
(setq c1 (1+ (read c1)))
)
(if (= c1 256) (setq c1 1))
(setq c2 c1)
(princ (strcat "\n当前颜色号 " (getvar "cecolor") "，设置颜色号 " (itoa c2) "。"))
(ett_ct)
(princ)
)
(princ "\n**Text文本编辑扩展工具。作者：南京市市政设计研究院嵇龙。**")
(princ "\n**命令：ett")

;;文本编辑扩展工具，文本修改后变换颜色显示。可以设置ddedit命令修改后文本 
;;的颜色，默认为当前系统颜色号加一，确认不修改为修改文本颜色号加一。 
;;作者：南京市市政设计研究院 嵇龙(ll_j@21cn.com) 
;;                                  025－3283626 
 
(defun ett_ct() 
  (initget "C  ") 
  (setq s0 (entsel "\n设置颜色C / 选取文本:")) 
  (cond 
    ( (= s0 "C") (ett_col)) 
    ( (= s0 "") nil) 
    ( (and (= (type s0) 'LIST) (= (cdr (assoc 0 (entget (car s0)))) "TEXT")) 
      (redraw (setq sn (car s0)) 3) 
      (setq s1 (entget sn) 
            n1 (cdr (assoc 1 s1)) 
      ) 
      (command "_.DDEDIT" sn "") 
      (entupd sn) 
      (if (/= n1 (cdr (assoc 1 (entget sn)))) 
        (progn 
          (setq s1 (entget sn)) 
          (if (/= (assoc 62 s1) nil) 
            (setq s1 (subst (cons 62 c2) (assoc 62 s1) s1)) 
            (setq s1 (cons (cons 62 c2) s1)) 
          ) 
          (entmod s1) 
          (redraw sn 1) 
        ) 
        (progn 
          (setq s1 (entget sn) c3(+ c2 1)) 
          (if (= c3 257) (setq c3 1)) 
          (if (/= (assoc 62 s1) nil) 
            (setq s1 (subst (cons 62 c3) (assoc 62 s1) s1)) 
            (setq s1 (cons (cons 62 c3) s1)) 
          ) 
          (entmod s1) 
          (redraw sn 1) 
        ) 
      ) 
      (setq sn nil) 
      (ett_ct) 
    ) 
    (t (ett_ct)) 
  ) 
) 
 
(defun ett_col() 
  (setq c1 c2) 
  (setq c2 (acad_colordlg c2)) 
  (if (= c2 nil) (setq c2 c1)) 
  (ett_ct) 
) 
 
(defun c:ett(/ sn s0 s1 c1 c2 c3 n1) 
  (setq c1 (getvar "CECOLOR")) 
  (if (or (= c1 "BYLAYER") (= c1 "BYBLOCK")) 
    (setq c1 1) 
    (setq c1 (1+ (read c1))) 
  ) 
  (if (= c1 256) (setq c1 1)) 
  (setq c2 c1) 
  (princ (strcat "\n当前颜色号 " (getvar "cecolor") "，设置颜色号 " (itoa c2) "。")) 
  (ett_ct) 
  (princ) 
) 
 
(princ "\n**Text文本编辑扩展工具。作者：南京市市政设计研究院 嵇龙。**") 
(princ "\n**命令：ett")

Gu_xl · 发表于 2012-2-29 18:53:30

;;文字变动监视示例代码

;;启动监视
(defun c:tt()
(or *dbreactor*
(setq *dbreactor* (vlr-acdb-reactor nil '((:vlr-objectModified . Dbdified)
)
)
)
)
(princ "\n文字编辑监视器启动")
(princ)
)
;;反应器
(defun Dbdified (reactor_object obj / e)
(if (or (= "MTEXT" (GXL-DXF (cadr obj) 0))
(= "TEXT" (GXL-DXF (cadr obj) 0))
)
(progn
(if (not (member (setq e (cadr obj)) *ModifiedList*))
(progn
(setq *ModifiedList* (cons (cadr obj) *ModifiedList*)
*enlst* nil)
(princ (strcat "\n" (itoa (length *ModifiedList*)) "个文字对象被修改！"))
)
)
)
)
)
;;显示更改文字
(defun c:tt1 ()
(if *ModifiedList*
(foreach en *ModifiedList*
(if (entget en)
(progn
(vlr-remove *dbreactor*)
(setq *ModifiedData*
(cons (cond ((setq color (gxl-dxf en 62)) (cons en color))
(t (cons en 256))
)
*ModifiedData*)
)
(gxl-ch_ent en 62 1)
(vlr-add *dbreactor*)
)
)
)
)
(princ)
)
;;关闭监视
(defun c:tt2 ()
(foreach a *ModifiedData*
(gxl-ch_ent (car a) 62 (cdr a))
)
(setq *ModifiedData* nil *ModifiedList* nil)
(vlr-remove *dbreactor*)
(setq *dbreactor* nil)
(princ "\n文字编辑监视器关闭")
(princ)
)
(defun gxl-dxf (ent i)
(cond ((= (type ent) 'ename)
(cdr (assoc i (entget ent '("*"))))
)
((= (type ent) 'list)
(cdr (assoc i ent))
)
) ;_ if
)
(defun gxl-CH_Ent (ent i pt / en)
(if (assoc i (setq en (entget ent)))
(setq en (subst (cons i pt) (assoc i en) en))
(setq en (append en (list (cons i pt))))
)
(entmod en)
)

;;启动监视 
(defun c:tt() 
  (or *dbreactor* 
      (setq *dbreactor* (vlr-acdb-reactor nil '((:vlr-objectModified . Dbdified) 
                                                ) 
                          ) 
            ) 
      ) 
  (princ "\n文字编辑监视器启动") 
  (princ) 
  ) 
;;反应器 
(defun Dbdified (reactor_object obj / e) 
    (if (or (= "MTEXT" (GXL-DXF (cadr obj) 0)) 
            (= "TEXT" (GXL-DXF (cadr obj) 0)) 
            ) 
      (progn 
        (if (not (member (setq e (cadr obj)) *ModifiedList*)) 
          (progn 
          (setq *ModifiedList* (cons (cadr obj) *ModifiedList*) 
                *enlst* nil) 
          (princ (strcat "\n" (itoa (length *ModifiedList*)) "个文字对象被修改！")) 
          ) 
          ) 
      ) 
      ) 
    ) 
;;显示更改文字 
(defun c:tt1 () 
  (if *ModifiedList* 
    (foreach en *ModifiedList* 
      (if (entget en) 
        (progn 
          (vlr-remove *dbreactor*) 
          (setq *ModifiedData* 
                 (cons (cond ((setq color (gxl-dxf en 62)) (cons en color)) 
                             (t (cons en 256)) 
                             ) 
                       *ModifiedData*) 
                ) 
        (gxl-ch_ent en 62 1) 
          (vlr-add *dbreactor*) 
        ) 
        ) 
      ) 
    ) 
  (princ) 
  ) 
;;关闭监视 
(defun c:tt2 () 
  (foreach a *ModifiedData* 
    (gxl-ch_ent (car a) 62 (cdr a)) 
    ) 
  (setq *ModifiedData* nil *ModifiedList* nil) 
  (vlr-remove *dbreactor*) 
  (setq *dbreactor* nil) 
  (princ "\n文字编辑监视器关闭") 
  (princ) 
  ) 
(defun gxl-dxf (ent i) 
    (cond ((= (type ent) 'ename) 
            (cdr (assoc i (entget ent '("*")))) 
             ) 
          ((= (type ent) 'list) 
           (cdr (assoc i ent)) 
           ) 
    ) ;_ if 
  ) 
(defun gxl-CH_Ent (ent i pt / en) 
  (if (assoc i (setq en (entget ent))) 
    (setq en (subst (cons i pt) (assoc i en) en)) 
    (setq en (append en (list (cons i pt)))) 
    ) 
    (entmod en) 
  )

qcw911 · 发表于 2012-2-29 19:19:18

变更后换颜色，非常有用!

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

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

本帖子中包含更多资源

本帖子中包含更多资源

点评

点评

评分