带关键字的ssget，个人修改版，可自定义函数进行后续操作

yjtdkj · 发表于 2021-7-6 16:43

没有用，浪费一个币

yjtdkj · 发表于 2021-7-6 17:41

发现问题所在了少了一个定义doc的过程，但是还是不能自动执行函数，只返回了文本

(defun c:tt ()
(setq Msg "\n 选择目标对象或 [读取图层(s b)]:"
keylist (list (cons "s" "ssFun_1") (cons "b" "ssFun_1"))
Fil '((0 . "line"))
)
(ssget-key Msg keylist Fil)
)
(defun ssFun_1 ()
(alert "现在是函数1")
)
(defun ssFun_2 ()
(alert "现在是函数1")
)
;;带关键字的ssget
;|(setq Msg "\n 选择目标对象或 [读取图层(S)]:"
keylist (list (cons "S" "ssFun_1") (cons "S" "ssFun_1"))
Fil (append layfil '((100 . "AcDbText")))
)|;
;;(defun ssFun_1 ()) 可自定义函数进行后续操作
(defun ssget-key (Msg keylist Fil / enp fun kwd myentsel pt2str ret)
(setq
*ACAD* (vlax-get-acad-object)
*DOC* (vla-get-ActiveDocument *ACAD*)
)
;;带过滤器的entsel
(if (eq (type keylist) 'str)
(setq Kwd keylist)
(setq
Kwd (apply 'strcat
(mapcar '(lambda (x) (strcat (car x) " ")) keylist)
)
)
)
(defun MyEntsel (msg fil /)
(princ "\n")
(setq enp (entsel msg))
(cond
((equal (type enp) 'STR)
(princ enp)
)
(T
(and enp (ssget (cadr enp) fil))
)
)
enp
)
;;点化字串
(defun Pt2Str (pt)
(strcat
(rtos (car pt) 2 3)
","
(rtos (cadr pt) 2 3)
","
(rtos (caddr pt) 2 3)
"\n"
)
)
(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))))
(setq ENP (ssget Fil))
)
((equal (TYPE enp) 'STR)
(setq ret (cdr (assoc enp keyList))
fun (eval (read ret))
enp (if (and (eq (type fun) 'SUBR) (wcmatch ret "ssFun_*"))
(fun)
ret
)
)
)
)
)
)
(princ "\n")
enp
)

(defun c:tt () 
  (setq        Msg        "\n 选择目标对象或 [读取图层(s b)]:" 
        keylist        (list (cons "s" "ssFun_1") (cons "b" "ssFun_1")) 
        Fil        '((0 . "line")) 
  ) 
  (ssget-key Msg keylist Fil) 
) 
(defun ssFun_1 () 
  (alert "现在是函数1") 
  ) 
(defun ssFun_2 () 
  (alert "现在是函数1") 
  ) 
;;带关键字的ssget 
;|(setq Msg     "\n 选择目标对象或 [读取图层(S)]:" 
      keylist (list (cons "S" "ssFun_1") (cons "S" "ssFun_1")) 
      Fil     (append layfil '((100 . "AcDbText"))) 
)|; 
;;(defun ssFun_1 ()) 可自定义函数进行后续操作 
(defun ssget-key (Msg keylist Fil / enp fun kwd myentsel pt2str ret) 
  (setq 
    *ACAD* (vlax-get-acad-object) 
    *DOC*  (vla-get-ActiveDocument *ACAD*) 
  ) 
  ;;带过滤器的entsel 
  (if (eq (type keylist) 'str) 
    (setq Kwd keylist) 
    (setq 
      Kwd (apply 'strcat 
                 (mapcar '(lambda (x) (strcat (car x) " ")) keylist) 
          ) 
    ) 
  ) 
  (defun MyEntsel (msg fil /) 
    (princ "\n") 
    (setq enp (entsel msg)) 
    (cond 
      ((equal (type enp) 'STR) 
       (princ enp) 
      ) 
      (T 
       (and enp (ssget (cadr enp) fil)) 
      ) 
    ) 
    enp 
  ) 
  ;;点化字串 
  (defun Pt2Str        (pt) 
    (strcat 
      (rtos (car pt) 2 3) 
      "," 
      (rtos (cadr pt) 2 3) 
      "," 
      (rtos (caddr pt) 2 3) 
      "\n" 
    ) 
  ) 
  (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)))) 
        (setq ENP (ssget Fil)) 
       ) 
       ((equal (TYPE enp) 'STR) 
        (setq ret (cdr (assoc enp keyList)) 
              fun (eval (read ret)) 
              enp (if (and (eq (type fun) 'SUBR) (wcmatch ret "ssFun_*")) 
                    (fun) 
                    ret 
                  ) 
        ) 
       ) 
     ) 
    ) 
  ) 
  (princ "\n") 
  enp 
)

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