再说带关键字的ssget

/db_自贡黄明儒_ · 发表于 2013-11-22 09:18:57

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

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

×

本帖最后由 /db_自贡黄明儒_ 于 2013-11-22 09:20 编辑

;|下面看格式刷
'_matchprop
Select source object:
Select destination object(s) or [Settings]:
最后一行时，我们可以直接选取目标，也可以输入"S"来进行设置，这就是特别之处。ll_j为我指点了一下，说飞诗的[带关键字的ssget]http://bbs.mjtd.com/thread-71545-1-1.html是他见过的最好的。昨天静心研读了一下，希望站在巨人的肩上看得更远,结果未如愿,看下面的程序Myssget，比较接近matchprop的用法了。Myssget可以输入一次S来进行设置，而matchprop可以任何时候输入S进行设置

initget之后，只有entsel起作用，ssget不起作用，飞诗还是开始打的entsel的主意
.各位有没有更好的办法呢？

|;

;;带关键字的ssget
;;(sslength(Myssget "\n 选择目标对象或 [设置(S)]:" "S " '((0 . "line"))))
(defun Myssget (Msg Kwd Fil)
;;带过滤器的entsel
(defun MyEntsel (msg fil / ENP)
(princ "\n")
(setq enp (entsel msg))
(cond ((equal (type enp) 'STR) (DoSth enp))
(T (and enp (ssget (cadr enp) fil)))
)
enp
)
;;initget时do
(defun DoSth (enp)
(princ enp)
)
;;点化字串
(defun Pt2Str (pt)
(strcat (rtos (car pt) 2 3)
","
(rtos (cadr pt) 2 3)
","
(rtos (caddr pt) 2 3)
"\n"
)
)
(or *DOC*
(setq *DOC* (vla-get-ActiveDocument (vlax-get-acad-object)))
)
(cond ((cadr (ssgetfirst)) (ssget "_P" fil))
(t
(initget Kwd) ;随后调用entsel时
(cond ((and (listp (MyEntsel Msg Fil))
(/= 52 (getvar "errno"))
)
(vla-sendcommand *doc* (Pt2Str (cadr (grread t))))
(ssget Fil)
)
(T (ssget Fil))
)
)
)
)

;;带关键字的ssget 
;;(sslength(Myssget "\n 选择目标对象或 [设置(S)]:" "S " '((0 . "line")))) 
(defun Myssget (Msg Kwd Fil) 
  ;;带过滤器的entsel 
  (defun MyEntsel (msg fil / ENP) 
    (princ "\n") 
    (setq enp (entsel msg)) 
    (cond ((equal (type enp) 'STR) (DoSth enp)) 
          (T (and enp (ssget (cadr enp) fil))) 
    ) 
    enp 
  ) 
  ;;initget时do 
  (defun DoSth (enp) 
    (princ enp) 
  ) 
  ;;点化字串 
  (defun Pt2Str        (pt) 
    (strcat (rtos (car pt) 2 3) 
            "," 
            (rtos (cadr pt) 2 3) 
            "," 
            (rtos (caddr pt) 2 3) 
            "\n" 
    ) 
  ) 
 
  (or *DOC* 
      (setq *DOC* (vla-get-ActiveDocument (vlax-get-acad-object))) 
  ) 
  (cond        ((cadr (ssgetfirst)) (ssget "_P" fil)) 
        (t 
         (initget Kwd)                                            ;随后调用entsel时 
         (cond ((and (listp (MyEntsel Msg Fil)) 
                     (/= 52 (getvar "errno")) 
                ) 
                (vla-sendcommand *doc* (Pt2Str (cadr (grread t)))) 
                (ssget Fil) 
               ) 
               (T (ssget Fil)) 
         ) 
        ) 
  ) 
)

;;调用系统格式刷，主要是显示那把刷子，do nothing
(defun C:test (/ E)
(setq e (car (entsel)))
(COMMAND "MATCHPROP" E)
(sslength
(Myssget "\n 选择目标对象或 [设置(S)]:" "S " '((0 . "line")))
)
(while (not (equal (getvar "cmdnames") "")) (command nil))
)

ll_j · 发表于 2013-11-22 09:41:58

大概从AutoLisp开始植入ACAD并被用户使用时，ssget不带关键字的这个问题就一直是大家的纠结，相信很多朋友在学习Alisp的时候也都试着解决这个问题，似乎都没有结果，或者说，结果都并不理想。
个人以为，飞诗的这段代码算是目前所能找到的Lisp代码中最好的，虽然也有一定的局限性和不尽人意的地方，但一般情况是可以应付的，他的这个思路也是被大家称作巧妙的，可惜后来就没有人再能试着更完善了。
一直想不通，自动桌子公司不知为什么就不把ssget扩展一下，在他们那里，这应该是比较容易的。
虽然说Lisp“无所不能”，但对普通用户而言，用Lisp去扩展这个功能的确不是一件容易的事。
根据对目前活跃在论坛的各位高手的了解，G版如果有兴趣，有结果的几率应该较高。

st788796 · 发表于 2013-11-22 10:29:45

ssget直接跟关键字还是有难度，因为ssget后面用了一些字符做模式的，"S" "F" "WP" "CP" "C" "W" "F" "A" "P"等等

/db_自贡黄明儒_ · 发表于 2013-11-22 10:35:11

st788796 发表于 2013-11-22 10:29
ssget直接跟关键字还是有难度，因为ssget后面用了一些字符做模式的，"S" "F" "WP" "CP" "C" "W" "F" "A" "P ...

飞诗考虑这些，"W L C BOX ALL F WP CP G A R M P U AU SI"，我倒觉得不用考虑它。因为其中调用ssget时，这些关键字照样可用。关键是我希望它响应别的关键字，从而do 一些事情。

/db_自贡黄明儒_ · 发表于 2013-11-22 10:36:51

ll_j 发表于 2013-11-22 09:41
大概从AutoLisp开始植入ACAD并被用户使用时，ssget不带关键字的这个问题就一直是大家的纠结，相信很多朋友 ...

这么一说，我就差不多绝望和死心了{:soso_e109:}

ll_j · 发表于 2013-11-22 11:26:50

/db_自贡黄明儒_ 发表于 2013-11-22 10:36
这么一说，我就差不多绝望和死心了

这也不一定，早期我试着做的时候还是纯Alisp，确实不行，说实在的，对函数的理解也不够，后来出了Vlisp，情况可能有些转机，飞诗的这段代码就是在Vlisp基础上的，这几年Vlisp也有了很大的提升（看G版的程序就有“只有做不到没有想不到”的感觉），有意的话，或许能有突破。
不过这里有一个是否值得的问题，说根本的，这个问题还是应该自动桌子来做，毕竟固化的函数是不局限于Lisp语言的。

牢固 · 发表于 2013-11-22 16:27:11

本帖最后由牢固于 2013-11-22 16:28 编辑

;;自定义SSGet框架，By Gu_xl;;参数 KWORD = 自定义关键字字串，可为nil
;; MSG = 提示信息,可为nil
;; FILTER = SSGET 过滤表
;; FUN = 根据关键字要执行的函数，(FUN KeyPosion SS),该函数返回值 '(T or nil<是否结束SSGET> 函数返回选择集)
(defun ssget1 (KWORD MSG FILTER FUN / KWD KWDS KWORDS
LOOP SS RES E N E1 GO GR PT
P3 P1 P2 P4 A
)
;;ssget自带的关键字，在KWORD中无需输入，可自动响应
;;(W)/上一个(L)/窗交(C)/框(BOX)/全部(ALL)/栏选(F)/圈围(WP)/圈交(CP)/编组(G)/添加(A)
;;/删除(R)/多个(M)/前一个(P)/放弃(U)/自动(AU)/单个(SI)
(setq kwd "W L C BOX ALL F WP CP G A R M P U AU SI"
kwds '("W" "L" "C" "BOX" "ALL" "F" "WP" "CP" "G" "A" "R" "M" "P"
"U" "AU" "SI")
)
(if kword
(progn
(setq kwords (mapcar 'VL-PRINC-TO-STRING (read (strcat "(" kword ")"))))
(setq kwd (strcat kwd " " kword))
)
)
(if (null msg)
(if kwords
(setq msg (strcat "\n选择对象["
(if kwords
(strcat
(car kwords)
(apply
'strcat
(apply
'mapcar
(cons
'strcat
(list
(mapcar
'(lambda (x) "/")
(cdr kwords)
)
(cdr kwords)
)
)
)
)
)
""
)
"]:"
)
)
(setq msg "\n选择对象:")
)
)
(setq loop t
ss (ssadd)
)
(while loop
(setvar 'errno 0)
(initget kwd)
(setq res (entsel msg))
(setq curpt (cadr (grread t 15)))
(if (/= 52 (getvar 'errno))
(progn
(cond
((or (not res ) (= 'list (type res)))
(setq res curpt)
(if filter
(setq e (ssget res filter))
(setq e (ssget res))
)
(if e
(repeat (setq n (sslength e))
(ssadd (setq e1 (ssname e (setq n (1- n)))) ss)
;;亮显图元
(redraw e1 3)
)
(progn
(setq go t)
(princ "指定对角点:")
(while go
(setq gr (grread t 15))
(cond
((= 5 (car gr))
(redraw)
(setq pt (cadr gr))
(if (< (car (setq p3 (trans pt 1 0)))
(car (setq p1 (trans res 1 0)))
)
(progn
(setq
p2 (trans (list (car p1) (cadr p3) 0) 0 1)
)
(setq
p4 (trans (list (car p3) (cadr p1) 0) 0 1)
)
(grvecs
(list -7
(list (car res) (cadr res))
(list (car p2) (cadr p2))
-7
(list (car p2) (cadr p2))
(list (car pt) (cadr pt))
-7
(list (car pt) (cadr pt))
(list (car p4) (cadr p4))
-7
(list (car p4) (cadr p4))
(list (car res) (cadr res))
)
)
)
(progn
(setq
p2 (trans (list (car p1) (cadr p3) 0) 0 1)
)
(setq
p4 (trans (list (car p3) (cadr p1) 0) 0 1)
)
(grvecs
(list 7
(list (car res) (cadr res))
(list (car p2) (cadr p2))
7
(list (car p2) (cadr p2))
(list (car pt) (cadr pt))
7
(list (car pt) (cadr pt))
(list (car p4) (cadr p4))
7
(list (car p4) (cadr p4))
(list (car res) (cadr res))
)
)
)
)
)
((= 3 (car gr))
(redraw)
(setq go nil)
(if (< (car (setq p3 (trans pt 1 0)))
(car (setq p1 (trans res 1 0)))
)
(progn
(if filter
(setq e (ssget "c" res (cadr gr) filter))
(setq e (ssget "c" res (cadr gr)))
)
(if e
(repeat (setq n (sslength e))
(ssadd (setq a (ssname e (setq n (1- n))))
ss
)
;;亮显图元
(redraw a 3)
)
)
)
(progn
(if filter
(setq e (ssget "w" res (cadr gr) filter))
(setq e (ssget "w" res (cadr gr)))
)
(if e
(repeat (setq n (sslength e))
(ssadd (setq a (ssname e (setq n (1- n))))
ss
)
;;亮显图元
(redraw a 3)
)
)
)
)
)
((or (= 25 (car gr))
(and (= 2 (car gr))
(or (= 13 (cadr gr)) (= 32 (cadr gr)))
)
)
(redraw)
(princ "\n窗口说明无效。 ")
(princ "\n指定对角点:")
)
)
)
)
)
)
((= 'str (type res))
(cond ((member (strcase res) kwds)
(if (> (sslength ss) 0)
(command "_select" ss res)
(command "_select" res)
)
(while (= 1 (logand (getvar 'cmdactive) 1))
(vl-cmdf pause)
)
(if filter
(progn
(setq e (ssget "_P" filter))
(if e
(progn
(setq ss e)
;;选择集亮显
(repeat (setq n (sslength ss))
(redraw (ssname ss (setq n (1- n))) 3)
)
)
)
)
(progn
(setq e (ssget "_P"))
(if e
(progn
(setq ss e)
;;选择集亮显
(repeat (setq n (sslength ss))
(redraw (ssname ss (setq n (1- n))) 3)
)
)
)
)
)
)
((and kwords (setq pos (VL-POSITION (strcase res) kwords)))
;;根据关键字来执行函数FUN
(setq result (vl-catch-all-apply (if (= 'SYM (type fun)) fun (function fun)) (list pos ss)))
(if (not (VL-CATCH-ALL-ERROR-P result))
(progn
(setq loop (car result)
ss (cadr result)
)
)
)
)
(t
(princ "\n错误关键字:")
)
)
)
)
)
(setq loop nil) ;_ 跳出循环
)
)
(if (and ss (> (sslength ss) 0))
(progn
;;取消选择集亮显
(repeat (setq n (sslength ss))
(redraw (ssname ss (setq n (1- n))) 4)
)
(command "_select" ss "")
;;返回选择集
ss
)
)
)
;;响应的函数,自己根据需要任意编写
(defun MyFun (pos ss)
(if ss
(cond ((= 0 pos) ;_ 第一个关键字响应,复制对象
(command "_copy" ss "" pause pause)
)
((= 1 pos) ;_ 第二个关键字响应，移动对象
(command "_move" ss "" pause pause)
)
)
)
(list t ss)
)
;;使用测试
(ssget1 "CO MO" "选择物体或[复制COpy/移动MOve]:" nil MyFun)

;;自定义SSGet框架，By Gu_xl;;参数 KWORD = 自定义关键字字串，可为nil 
;;     MSG = 提示信息,可为nil 
;;     FILTER = SSGET 过滤表 
;;     FUN = 根据关键字要执行的函数，(FUN KeyPosion SS),该函数返回值 '(T or nil<是否结束SSGET> 函数返回选择集) 
(defun ssget1 (KWORD        MSG   FILTER FUN          /        KWD   KWDS  KWORDS 
                  LOOP        SS    RES   E          N        E1    GO    GR          PT 
                  P3        P1    P2    P4          A 
                 ) 
  ;;ssget自带的关键字，在KWORD中无需输入，可自动响应 
  ;;(W)/上一个(L)/窗交(C)/框(BOX)/全部(ALL)/栏选(F)/圈围(WP)/圈交(CP)/编组(G)/添加(A) 
  ;;/删除(R)/多个(M)/前一个(P)/放弃(U)/自动(AU)/单个(SI) 
  (setq        kwd  "W L C BOX ALL F WP CP G A R M P U AU SI" 
        kwds '("W" "L" "C" "BOX" "ALL" "F" "WP"        "CP" "G" "A" "R" "M" "P" 
               "U" "AU"        "SI") 
  ) 
  (if kword 
    (progn 
      (setq kwords (mapcar 'VL-PRINC-TO-STRING (read (strcat "(" kword ")")))) 
      (setq kwd (strcat kwd " " kword)) 
    ) 
  ) 
  (if (null msg) 
    (if        kwords 
      (setq msg        (strcat        "\n选择对象[" 
                        (if kwords 
                          (strcat 
                            (car kwords) 
                            (apply 
                              'strcat 
                              (apply 
                                'mapcar 
                                (cons 
                                  'strcat 
                                  (list 
                                    (mapcar 
                                      '(lambda (x) "/") 
                                      (cdr kwords) 
                                    ) 
                                    (cdr kwords) 
                                  ) 
                                ) 
                              ) 
                            ) 
                          ) 
                          "" 
                        ) 
                        "]:" 
                ) 
      ) 
      (setq msg "\n选择对象:") 
 
    ) 
  ) 
  (setq        loop t 
        ss   (ssadd) 
  ) 
  (while loop 
    (setvar 'errno 0) 
    (initget kwd) 
    (setq res (entsel msg)) 
    (setq curpt (cadr (grread t 15))) 
 
    (if        (/= 52 (getvar 'errno)) 
      (progn 
        (cond 
          ((or (not res ) (= 'list (type res))) 
           (setq res curpt) 
           (if filter 
             (setq e (ssget res filter)) 
             (setq e (ssget res)) 
           ) 
           (if e 
             (repeat (setq n (sslength e)) 
               (ssadd (setq e1 (ssname e (setq n (1- n)))) ss) 
               ;;亮显图元 
               (redraw e1 3) 
             ) 
             (progn 
               (setq go t) 
               (princ "指定对角点:") 
               (while go 
                 (setq gr (grread t 15)) 
                 (cond 
                   ((= 5 (car gr)) 
                    (redraw) 
                    (setq pt (cadr gr)) 
                    (if        (< (car (setq p3 (trans pt 1 0))) 
                           (car (setq p1 (trans res 1 0))) 
                        ) 
                      (progn 
 
                        (setq 
                          p2 (trans (list (car p1) (cadr p3) 0) 0 1) 
                        ) 
                        (setq 
                          p4 (trans (list (car p3) (cadr p1) 0) 0 1) 
                        ) 
                        (grvecs 
                          (list        -7 
                                (list (car res) (cadr res)) 
                                (list (car p2) (cadr p2)) 
                                -7 
                                (list (car p2) (cadr p2)) 
                                (list (car pt) (cadr pt)) 
                                -7 
                                (list (car pt) (cadr pt)) 
                                (list (car p4) (cadr p4)) 
                                -7 
                                (list (car p4) (cadr p4)) 
                                (list (car res) (cadr res)) 
                          ) 
                        ) 
                      ) 
                      (progn 
                        (setq 
                          p2 (trans (list (car p1) (cadr p3) 0) 0 1) 
                        ) 
                        (setq 
                          p4 (trans (list (car p3) (cadr p1) 0) 0 1) 
                        ) 
                        (grvecs 
                          (list        7 
                                (list (car res) (cadr res)) 
                                (list (car p2) (cadr p2)) 
                                7 
                                (list (car p2) (cadr p2)) 
                                (list (car pt) (cadr pt)) 
                                7 
                                (list (car pt) (cadr pt)) 
                                (list (car p4) (cadr p4)) 
                                7 
                                (list (car p4) (cadr p4)) 
                                (list (car res) (cadr res)) 
                          ) 
                        ) 
                      ) 
                    ) 
                   ) 
                   ((= 3 (car gr)) 
                    (redraw) 
                    (setq go nil) 
                    (if        (< (car (setq p3 (trans pt 1 0))) 
                           (car (setq p1 (trans res 1 0))) 
                        ) 
                      (progn 
                        (if filter 
                          (setq e (ssget "c" res (cadr gr) filter)) 
                          (setq e (ssget "c" res (cadr gr))) 
                        ) 
                        (if e 
                          (repeat (setq n (sslength e)) 
                            (ssadd (setq a (ssname e (setq n (1- n)))) 
                                   ss 
                            ) 
                            ;;亮显图元 
                            (redraw a 3) 
                          ) 
                        ) 
                      ) 
                      (progn 
                        (if filter 
                          (setq e (ssget "w" res (cadr gr) filter)) 
                          (setq e (ssget "w" res (cadr gr))) 
                        ) 
                        (if e 
                          (repeat (setq n (sslength e)) 
                            (ssadd (setq a (ssname e (setq n (1- n)))) 
                                   ss 
                            ) 
                            ;;亮显图元 
                            (redraw a 3) 
                          ) 
                        ) 
                      ) 
                    ) 
                   ) 
                   ((or        (= 25 (car gr)) 
                        (and (= 2 (car gr)) 
                             (or (= 13 (cadr gr)) (= 32 (cadr gr))) 
                        ) 
                    ) 
                    (redraw) 
                    (princ "\n窗口说明无效。 ") 
                    (princ "\n指定对角点:") 
                   ) 
                 ) 
               ) 
             ) 
           ) 
          ) 
          ((= 'str (type res)) 
           (cond ((member (strcase res) kwds) 
                  (if (> (sslength ss) 0) 
                    (command "_select" ss res) 
                    (command "_select" res) 
                  ) 
                  (while (= 1 (logand (getvar 'cmdactive) 1)) 
                    (vl-cmdf pause) 
                  ) 
                  (if filter 
                    (progn 
                      (setq e (ssget "_P" filter)) 
                      (if e 
                        (progn 
                          (setq ss e) 
                          ;;选择集亮显 
                          (repeat (setq n (sslength ss)) 
                            (redraw (ssname ss (setq n (1- n))) 3) 
                          ) 
                        ) 
                      ) 
                    ) 
                    (progn 
                      (setq e (ssget "_P")) 
                      (if e 
                        (progn 
                          (setq ss e) 
                          ;;选择集亮显 
                          (repeat (setq n (sslength ss)) 
                            (redraw (ssname ss (setq n (1- n))) 3) 
                          ) 
                        ) 
                      ) 
                    ) 
                  ) 
                 ) 
                 ((and kwords (setq pos (VL-POSITION (strcase res) kwords))) 
                  ;;根据关键字来执行函数FUN 
                  (setq result (vl-catch-all-apply (if (= 'SYM (type fun)) fun (function fun)) (list pos ss))) 
                  (if (not (VL-CATCH-ALL-ERROR-P result)) 
                    (progn 
                      (setq loop (car result) 
                            ss (cadr result) 
                            ) 
                      
                      ) 
                    ) 
 
                 ) 
                 (t 
                  (princ "\n错误关键字:") 
                 ) 
           ) 
          ) 
        ) 
      ) 
      (setq loop nil) ;_ 跳出循环 
    ) 
  ) 
  (if (and ss (> (sslength ss) 0)) 
    (progn 
      ;;取消选择集亮显 
      (repeat (setq n (sslength ss)) 
        (redraw (ssname ss (setq n (1- n))) 4) 
      ) 
      (command "_select" ss "") 
      ;;返回选择集 
      ss 
    ) 
  ) 
) 
;;响应的函数,自己根据需要任意编写 
(defun MyFun (pos ss) 
  (if ss 
  (cond ((= 0 pos) ;_ 第一个关键字响应,复制对象 
         (command "_copy" ss "" pause pause) 
         ) 
        ((= 1 pos) ;_ 第二个关键字响应，移动对象 
         (command "_move" ss "" pause pause) 
         ) 
        ) 
    ) 
  (list t ss) 
  ) 
;;使用测试 
(ssget1 "CO MO" "选择物体或[复制COpy/移动MOve]:" nil MyFun)

/db_自贡黄明儒_ · 发表于 2013-11-22 16:54:14

牢固发表于 2013-11-22 16:27

好复杂的代码，得好好学习一下

Lisphk · 发表于 2016-9-20 22:49:43

牢固发表于 2013-11-22 16:27

消化下G版的这段代码，谢谢！！

Lisphk · 发表于 2016-9-20 22:54:52

不知道用 ENTSEL组合GETPOINT,GETCORNER 能不知道实现，
ENTSEL选择为空的时候，用GETCORNER拉窗口，然后用SSGET的C,CP,WP,利用窗口来构建选择集。

通过ENTSEL和GET类函数获得关键字。

sicky111 · 发表于 2016-9-22 08:24:47

学习了。

yjch · 发表于 2016-9-24 07:57:20

好好学习天天向上

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

[研讨] 再说带关键字的ssget

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

相关帖子

点评

点评

点评

评分

[研讨] 再说 带关键字的ssget

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

相关帖子

点评

点评

点评

评分

[研讨] 再说带关键字的ssget