相同刷：XX

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

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日====================;;;

;;改编自 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
也是同样是BUG，右键和ESC有时候不能退出

会有这种事？？？

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

自贡黄明儒发表于 2013-7-9 16:01
会有这种事？？？

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

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

本帖子中包含更多资源

评分

本帖被以下淘专辑推荐:

评分

点评

点评