相同刷：XX

/db_自贡黄明儒_ · 发表于 2013-7-5 20:15:09

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

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

st788796 · 发表于 2013-7-5 20:30:29

以前有过可"自由定制"的刷子

fjb54007 · 发表于 2014-11-14 21:52:49

正需要，谢谢楼主分享

xvjiex · 发表于 2021-7-25 00:02:58

感谢楼主分享相同刷：XX

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

[每日一码] 相同刷：XX

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

评分