选择格式刷后，可以输入S进行设置，也可直接选取要被格式化的对象

/db_自贡黄明儒_

st788796 发表于 2013-10-12 10:54
看看eachy版主那个超级刷子，就是这个用法，s  设置

说到底，我就是想改造这个刷子，但eachy的程序不出现刷子。但wkai改后每次要出现对话框，如果这个对话框在输入S之后出而且有刷子，该多好呀

ll_j

/db_自贡黄明儒_ 发表于 2013-10-12 10:47
12的程序太多，简化一下，我是想改造下面的程序

大致这样用：

1. 
   
2. (defun my (e)
   
3.   (setq p T)
   
4.   (while p
   
5.     (setq p (fsxm-ssget "\n选择需要刷新的对象或 [设置(S)]: " "S" nil))
   
6.     (cond ((= p "S") (myset))
   
7.           (T p)
   
8.     )
   
9.   )
   
10. )
    

<br /> (defun my (e)<br />   (setq p T)<br />   (while p<br />     (setq p (fsxm-ssget "\n选择需要刷新的对象或 [设置(S)]: " "S" nil))<br />     (cond ((= p "S") (myset))<br />           (T p)<br />     )<br />   )<br /> )<br />

/db_自贡黄明儒_

ll_j 发表于 2013-10-12 11:10
大致这样用：

;;离我的目的地还是要差一点

2. (defun C:w1 (/ E P SS)
   
3.   (defun my (e)
   
4.     (setq p T)
   
5.     (while p
   
6.       (setq p (fsxm-ssget "\n选择需要刷新的对象或 [设置(S)]: " "S" nil))
   
7.       (cond ((= p "S") (princ p));<FONT color=red>do something
   
8. </FONT>            (T p)
   
9.       )
   
10.     )
    
11.   )
    
12.   (setq e (car (entsel)))
    
13.   (COMMAND "MATCHPROP" E)
    
14.   (my e)
    
15.   (while (not (equal (getvar "cmdnames") "")) (command nil))
    
16. )
    
17. 
    
18. (vl-load-com)
    
19. (setq *acad* (vlax-get-acad-object))
    
20. (setq *doc* (vla-get-ActiveDocument *acad*))
    
21. ;;带过滤器的entsel
    
22. (defun Fsxm-entsel (msg filter)
    
23.   (setq enp (entsel msg))
    
24.   (if (or (= (type enp) 'str)
    
25.           (and enp (ssget (cadr enp) filter))
    
26.       )
    
27.     enp
    
28.   )
    
29. )
    
30. ;;;用分隔符解释字符串成表
    
31. (defun Fsxm-Split (string strkey / po strlst xlen)
    
32.   (setq xlen (1+ (strlen strkey)))
    
33.   (while (setq po (vl-string-search strkey string))
    
34.     (setq strlst (cons (substr string 1 po) strlst))
    
35.     (setq string (substr string (+ po xlen)))
    
36.   )
    
37.   (reverse (cons string strlst))
    
38. )
    
39. ;;点化字串
    
40. (defun Pt2Str (pt)
    
41.   (strcat (rtos (car pt) 2 20)
    
42.           ","
    
43.           (rtos (cadr pt) 2 20)
    
44.           ","
    
45.           (rtos (caddr pt) 2 20)
    
46.           "\n"
    
47.   )
    
48. )
    
49. ;;带关键字的ssget
    
50. (defun Fsxm-ssget (Msg Kwd Fil / Kwd0 pt var)
    
51.   (cond        ((cadr (ssgetfirst)))
    
52.         (t
    
53.          (setq Kwd0 "W L C BOX ALL F WP CP G A R M P U AU SI")
    
54.          (initget (strcat Kwd0 " " kwd))
    
55.          (cond ((and (listp (setq var (fsxm-entsel Msg Fil)))
    
56.                      (/= 52 (getvar "errno"))
    
57.                 )
    
58.                 (vla-sendcommand *doc* (Pt2Str (cadr (grread t))))
    
59.                 (ssget Fil)
    
60.                )
    
61.                ((member var (fsxm-split Kwd0 " "))
    
62.                 (vla-sendcommand *doc* (strcat var "\n"))
    
63.                 (ssget Fil)
    
64.                )
    
65.                (t var)
    
66.          )
    
67.         )
    
68.   )
    
69. )
    

(defun C:w1 (/ E P SS)<br />   (defun my (e)<br />     (setq p T)<br />     (while p<br />       (setq p (fsxm-ssget "\n选择需要刷新的对象或 [设置(S)]: " "S" nil))<br />       (cond ((= p "S") (princ p));<FONT color=red>do something<br /> </FONT>            (T p)<br />       )<br />     )<br />   )<br />   (setq e (car (entsel)))<br />   (COMMAND "MATCHPROP" E)<br />   (my e)<br />   (while (not (equal (getvar "cmdnames") "")) (command nil))<br /> )<br /> <br /> (vl-load-com)<br /> (setq *acad* (vlax-get-acad-object))<br /> (setq *doc* (vla-get-ActiveDocument *acad*))<br /> ;;带过滤器的entsel<br /> (defun Fsxm-entsel (msg filter)<br />   (setq enp (entsel msg))<br />   (if (or (= (type enp) 'str)<br />           (and enp (ssget (cadr enp) filter))<br />       )<br />     enp<br />   )<br /> )<br /> ;;;用分隔符解释字符串成表<br /> (defun Fsxm-Split (string strkey / po strlst xlen)<br />   (setq xlen (1+ (strlen strkey)))<br />   (while (setq po (vl-string-search strkey string))<br />     (setq strlst (cons (substr string 1 po) strlst))<br />     (setq string (substr string (+ po xlen)))<br />   )<br />   (reverse (cons string strlst))<br /> )<br /> ;;点化字串<br /> (defun Pt2Str (pt)<br />   (strcat (rtos (car pt) 2 20)<br />           ","<br />           (rtos (cadr pt) 2 20)<br />           ","<br />           (rtos (caddr pt) 2 20)<br />           "\n"<br />   )<br /> )<br /> ;;带关键字的ssget<br /> (defun Fsxm-ssget (Msg Kwd Fil / Kwd0 pt var)<br />   (cond        ((cadr (ssgetfirst)))<br />         (t<br />          (setq Kwd0 "W L C BOX ALL F WP CP G A R M P U AU SI")<br />          (initget (strcat Kwd0 " " kwd))<br />          (cond ((and (listp (setq var (fsxm-entsel Msg Fil)))<br />                      (/= 52 (getvar "errno"))<br />                 )<br />                 (vla-sendcommand *doc* (Pt2Str (cadr (grread t))))<br />                 (ssget Fil)<br />                )<br />                ((member var (fsxm-split Kwd0 " "))<br />                 (vla-sendcommand *doc* (strcat var "\n"))<br />                 (ssget Fil)<br />                )<br />                (t var)<br />          )<br />         )<br />   )<br /> )<br />

st788796

/db_自贡黄明儒_ 发表于 2013-10-12 11:32
;;离我的目的地还是要差一点

matchprop设不了那么多属性，你可以自己做一个刷子形状，提示选择的时候让这个形状跟随光标，类似支持捕捉的Grread

kern

搞得这么复杂，LISP还是让他简单一点好了咯。

要求这么高了上ARX吧，不会让你失望的。