社区 › AutoLISP/Visual LISP 编程技术 › 相同刷：XX

自贡黄明儒 发表于 2013-7-5 20:11:59

相同刷：XX

Caoying以前发过一把刷子
wowan1314成功调用了系统的刷子
这样明经就有俩把刷子了
下面是调用系统的刷子的示列

;;改编自 wowan1314==============自贡黄明儒2013年6月28日====================;;;
(DEFUN C:XX (/ E ENTLIS NAME SHORTC UU)
;;1 错误处理
(defun *error* (s)
    (if        (= 8 (logand (getvar "undoctl") 8))
      (command "_.undo" "_e")
    )
    (setvar "SHORTCUTMENU" SHORTC)
    (setvar "nomutt" 0)
)
;;2 处理文字
(defun XX:Text (UU / ENT N SS X)
    (WHILE (not (member (car (grread T 5 2)) '(11 12 25)))
      (princ "\n 目标:文字刷为相同内容")
      (setvar "nomutt" 1)
      (SETQ
        SS (vl-catch-all-apply
             '(LAMBDA NIL
                (SSGET ":S:L"
                     '((0 . "*TEXT"))
                )
              )
           )
      )
      (setvar "nomutt" 0)
      (IF (VL-CATCH-ALL-ERROR-P SS)
        nil
        (if ss
          (REPEAT (SETQ N (SSLENGTH SS))
          (SETQ X (SSNAME SS (SETQ N (1- N))))
          (setq ent (entget x))
          (entmod (subst UU (assoc 1 ent) ent))
          )
        )
      )
    )
)
;;3 块
(defun XX:Insert (UU / ENT N SS X)
    (WHILE (not (member (car (grread T 5 2)) '(11 12 25)))
      (princ "\n 目标:块相同")
      (setvar "nomutt" 1)
      (SETQ
        SS (vl-catch-all-apply
             '(LAMBDA NIL
                (SSGET ":S:L"
                     '((0 . "INSERT"))
                )
              )
           )
      )
      (setvar "nomutt" 0)
      (IF (VL-CATCH-ALL-ERROR-P SS)
        NIL
        (IF SS
          (REPEAT (SETQ N (SSLENGTH SS))
          (SETQ X (SSNAME SS (SETQ N (1- N))))
          (setq ent (entget x))
          (entmod (subst UU (assoc 2 ent) ent))
          )
        )
      )
    )
)
;;4 处理圆
(defun XX:CIR        (UU / ENT N SS X)
    (WHILE (not (member (car (grread T 5 2)) '(11 12 25)))
      (princ "\n 目标：相同圆")
      (setvar "nomutt" 1)
      (SETQ
        SS (vl-catch-all-apply
             '(LAMBDA NIL
                (SSGET ":S:L"
                     '((0 . "CIRCLE"))
                )
              )
           )
      )
      (setvar "nomutt" 0)
      (IF (VL-CATCH-ALL-ERROR-P SS)
        nil
        (if ss
          (REPEAT (SETQ N (SSLENGTH SS))
          (SETQ X (SSNAME SS (SETQ N (1- N))))
          (setq ent (entget x))
          (entmod (subst UU (assoc 40 ent) ent))
          )
        )
      )
    )
)
;;5 属性
(defun XX:att        (UU / ENT N SS X)
    (WHILE (not (member (car (grread T 5 2)) '(11 12 25)))
      (princ "\n 目标:属性相同")
      (setvar "nomutt" 1)
      (SETQ
        SS (vl-catch-all-apply
             '(LAMBDA NIL
                (SSGET ":S:L"
                     '((0 . "ATTDEF"))
                )
              )
           )
      )
      (setvar "nomutt" 0)
      (IF (VL-CATCH-ALL-ERROR-P SS)
        NIL
        (IF SS
          (REPEAT (SETQ N (SSLENGTH SS))
          (SETQ X (SSNAME SS (SETQ N (1- N))))
          (setq ent (entget x))
          (entmod (subst UU (assoc 2 ent) ent))
          )
        )
      )
    )
)
;;6 主
(setq SHORTC (getvar "SHORTCUTMENU"))
(setvar "SHORTCUTMENU" 0)
(setvar "nomutt" 1)
(while (not E)
    (princ "\n 选择源:文字、块、圆")
    (setq e (SSGET ":S:E"
                   '((0 . "*TEXT,INSERT,CIRCLE,ATTDEF"))
          )
    )
)
(setvar "nomutt" 0)
(setq entlis (ENTGET (SETQ E (SSNAME E 0))))
(setq name (cdr (assoc 0 entlis)))
(cond        ((member name (list "TEXT" "MTEXT"))
       (setq UU (ASSOC 1 entlis))
        )
        ((equal name "INSERT") (setq UU (ASSOC 2 entlis)))
        ((equal name "ATTDEF") (setq UU (ASSOC 2 entlis)))
        (T (setq UU (ASSOC 40 entlis)))
)
(COMMAND "MATCHPROP" E)
(cond        ((equal name "INSERT") (XX:Insert UU))
        ((equal name "ATTDEF") (XX:att UU))
        ((equal name "CIRCLE") (XX:CIR UU))
        (t (XX:Text UU))
)
;;(if (/= (getvar "cmdactive") 0)(COMMAND ""))
(while (not (equal (getvar "cmdnames") "")) (command nil))
(setvar "SHORTCUTMENU" SHORTC)
(PRINC)
)
;;改编自 wowan1314==============自贡黄明儒2013年6月28日====================;;;

evayleung 发表于 2018-6-26 02:10:50

不知大家有没这样的问题，刷普通CAD文字时没问题，单选天正文字时也没什么问题，多选天正文字的时候极易出现CAD崩溃。

evayleung 发表于 2018-6-26 02:11:26

如果不用COMMAND那命令调用系统的刷子就不会有事的，这选一个BUG吗？

ucuc2003 发表于 2013-7-5 20:22:36

本帖最后由 ucuc2003 于 2013-7-9 15:31 编辑

我来把论坛的三把刷子汇总下：
1、langjs 大侠的《相同刷v2.0》：http://bbs.mjtd.com/thread-101921-1-1.html
                        《相同刷v1.0》：http://bbs.mjtd.com/forum.php?mod=viewthread&tid=91302
2、wowan1314 大侠的《带刷子的文字内容刷》：http://bbs.mjtd.com/thread-102218-1-1.html
3、黄明儒大侠的《相同刷：XX》：http://bbs.mjtd.com/thread-102360-1-1.html

ucuc2003 发表于 2013-7-5 20:43:56

也是同样是BUG，右键和ESC有时候不能退出

自贡黄明儒 发表于 2013-7-5 21:01:08

ucuc2003 发表于 2013-7-5 20:43 static/image/common/back.gif
也是同样是BUG，右键和ESC有时候不能退出

会有这种事？？？

ucuc2003 发表于 2013-7-5 21:04:15

自贡黄明儒 发表于 2013-7-9 16:01 static/image/common/back.gif
会有这种事？？？

是的刚才测试了，调用的刷子很完美，但是有时候ＥＳＣ和右键退不出来．其他问题未发现

669423907 发表于 2013-7-6 14:02:47

果断支持顶上！嘻唰唰

q3_2006 发表于 2013-7-6 15:56:48

能不能进阶到能刷块内文本呀！

ydw621 发表于 2013-7-6 16:30:53

顶，谢谢黄大侠。

726613 发表于 2013-7-7 05:38:39

支持源码学习

yansu 发表于 2013-7-7 06:43:50

支持天正的多行文字，天正引线标注文字吗

查看完整版本: 相同刷：XX