[原创]带关键字的ssget

飞诗(fsxm)

虽然理论上可以为任意的关键字，
但是为了保持与CAD的选择的习惯一致，
在这个函数中我特意摒避了CAD内置于SSGET中的关键字~
主要思路给出来了，要别的类似效果的自己改下就成！
同时也请大家严格尊重用户习惯~不要乱用系统内置关键字。

1. ;;函数库（用FSTL用户可以不加）
   
2. ;;带关键字的ssget
   
3. (defun fsxm-ssget (Msg Kwd Fil / Kwd0 pt var)
   
4.   (cond        ((cadr (ssgetfirst)))
   
5.         (t
   
6.          (setq Kwd0 "W L C BOX ALL F WP CP G A R M P U AU SI")
   
7.          (initget (strcat Kwd0 " " kwd))
   
8.          (cond ((and (listp (setq var (fsxm-entsel Msg Fil)))
   
9.                      (/= 52 (getvar "errno"))
   
10.                 )
    
11.                 (setq pt (mapcar 'fsxm-tostring (cadr (grread t))))
    
12.                 (vla-sendcommand *doc* (strcat (fsxm-join pt ",") "\n"))
    
13.                 (ssget Fil)
    
14.                )
    
15.                ((member var (fsxm-split Kwd0 " "))
    
16.                 (vla-sendcommand *doc* (strcat var "\n"))
    
17.                 (ssget Fil)
    
18.                )
    
19.                (t var)
    
20.          )
    
21.         )
    
22.   )
    
23. )
    

;;函数库（用FSTL用户可以不加）<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 />                 (setq pt (mapcar 'fsxm-tostring (cadr (grread t))))<br />                 (vla-sendcommand *doc* (strcat (fsxm-join pt ",") "\n"))<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 />

下面是完整的版本：

1. (vl-load-com)
   
2. (setq *acad* (vlax-get-acad-object))
   
3. (setq *doc* (vla-get-ActiveDocument *acad*))
   
4. ;;带过滤器的entsel
   
5. (defun Fsxm-entsel (msg filter)
   
6.   (setq enp (entsel msg))
   
7.   (if (or (= (type enp) 'str)
   
8.           (and enp (ssget (cadr enp) filter))
   
9.       )
   
10.     enp
    
11.   )
    
12. )
    
13. ;;;用分隔符解释字符串成表
    
14. (defun Fsxm-Split (string strkey / po strlst xlen)
    
15.   (setq xlen (1+ (strlen strkey)))
    
16.   (while (setq po (vl-string-search strkey string))
    
17.     (setq strlst (cons (substr string 1 po) strlst))
    
18.     (setq string (substr string (+ po xlen)))
    
19.   )
    
20.   (reverse (cons string strlst))
    
21. )
    
22. ;;点化字串
    
23. (defun Pt2Str (pt)
    
24.   (strcat (rtos (car pt) 2 20)
    
25.           ","
    
26.           (rtos (cadr pt) 2 20)
    
27.           ","
    
28.           (rtos (caddr pt) 2 20)
    
29.           "\n"
    
30.   )
    
31. )
    
32. ;;带关键字的ssget
    
33. (defun Fsxm-ssget (Msg Kwd Fil / Kwd0 pt var)
    
34.   (cond        ((cadr (ssgetfirst)))
    
35.         (t
    
36.          (setq Kwd0 "W L C BOX ALL F WP CP G A R M P U AU SI")
    
37.          (initget (strcat Kwd0 " " kwd))
    
38.          (cond ((and (listp (setq var (fsxm-entsel Msg Fil)))
    
39.                      (/= 52 (getvar "errno"))
    
40.                 )
    
41.                 (vla-sendcommand *doc* (Pt2Str (cadr (grread t))))
    
42.                 (ssget Fil)
    
43.                )
    
44.                ((member var (fsxm-split Kwd0 " "))
    
45.                 (vla-sendcommand *doc* (strcat var "\n"))
    
46.                 (ssget Fil)
    
47.                )
    
48.                (t var)
    
49.          )
    
50.         )
    
51.   )
    
52. )
    

(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 />

cghdy

liminnet 发表于 2008-11-4 15:50
本帖最后由 作者 于 2008-11-4 15:51:37 编辑  (defun c:mjtd(/ setmode ss i mode)&nbsp; (cmdbe)&nbsp;& ...

缺少部分源码

cghdy

没有例子是件很悲伤的事。

LIULISHENG

原来有这么好的东东

liminnet

不错，飞哥，你真是天才，一级棒，

jxlsp

是不是2008的ssget有关键字了.

carrot1983

飞诗总有精品...强烈支持...

nonsmall

强悍 好思路

鬼谷子

在

liminnet

(defun c:mjtd(/ setmode ss i mode)
  (cmdbe)
   (princ"\n程序功能：快速剪掉多段线内或外的对象")
  (if mode mode (setq mode "内部"))
  (setq setmode t)
  (while setmode
           (princ (strcat "\n当前剪切模式是:" mode))
           (setq ss (ko-ssget (strcat "\n选择对象或[设置剪切环境(S)<" mode ">]:") "S" '((0 . "*polyline"))))
           (cond
                ((= ss "S") (setq mode (settrimmode mode))
                )
                ((= (type ss) 'PICKSET) (trimmainprogram ss) (setq setmode nil)
                )
                ((= ss nil) (setq setmode nil)
  )
           )
  )
  (cmde)
  (princ)
)

(defun trimmainprogram(ss / i lst ena)
     (command "._zoom" "o" ss "")
     (setq i 0)
     (repeat (sslength ss)
       (setq ena (ko-convert-pline (ssname ss i)))
       (cond
         ((= mode "内部") 
           (setq lst (ko-get->list-offsetpline ena t 3))
           (command "._trim" ena "" "f")
           (foreach x lst (command "non" x))
           (command (car lst) "" "")
         )
         ((= mode "外部")
            (setq lst (ko-get->list-offsetpline ena nil 3))
            (command "._trim" ena "" "f")
            (foreach x lst (command "non" x))
            (command (car lst) "" "")
         )
      )
       (setq i (1+ i))
    )
    (command "._zoom" "p")
)
(defun settrimmode(mode / value)
   (initget "V Q")
   (setq value (getkword (strcat "\n[内部(V)/外部(Q)<" mode ">]:")))
   (cond
       ((= value "V") (setq value "内部"))
       ((= value nil) (setq value mode))
       ((= value "Q") (setq value "外部"))
   )
  value
)

;;;;借用了飞哥的上面的一颗奔腾CPU8核心处理器 来改装把我的程序一下，

;;;;多谢谢飞哥哥啦

liminnet

飞哥，为什么你上面的程序执行后，用空格来响应命令时，不会退出，而是去选择一个点呀，飞哥，可以解决空格能退出程序的问题吗

liminnet

而且这个点的坐标是34146.72050038344,-585.7550495938848,0.000000000000000 怎么这么长的数据呀，不知道可以不要显示出这个坐标的值出来吗，

飞诗(fsxm)

用这个方法实现的就不能不显示~！

你可以研究别的方法试下哈~