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

没有用,浪费一个币

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

发现问题所在了少了一个定义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
)
页: 1 [2]
查看完整版本: 带关键字的ssget,个人修改版,可自定义函数进行后续操作