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

bloodtempt · 发表于 2020-8-12 08:05

本帖最后由 bloodtempt 于 2020-8-12 08:08 编辑

(defun C:s+ (/ ss ssfun)
(defun ssFun_1 ()
(setq layfil (list (assoc 8 (entget (car (entsel "\n 选择参照图元"))))))
layfil
(ssget-key "\n 选择目标对象或 [读取图层(S)]:" (list (cons "S" "ssFun_1")) (append layfil '((100 . "AcDbText"))))
)
(setq ss (ssget-key "\n 选择目标对象或 [读取图层(S)]:" (list (cons "S" "ssFun_1")) (append layfil '((100 . "AcDbText")))))
)

cghdy · 发表于 2020-8-13 10:10

提示vla-object nil

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 
)

cghdy · 发表于 2020-8-14 10:42

bloodtempt 发表于 2020-8-14 10:19
"AcDbText"改成"*Text"试试，AcDbText是天正文字

不单是天正的，我的字体100的组码也是AcDbText

bloodtempt · 发表于 2020-8-13 17:45

cghdy 发表于 2020-8-13 10:10
提示vla-object nil

前面添加(vl-load-com)

cghdy · 发表于 2020-8-13 22:49

bloodtempt 发表于 2020-8-13 17:45
前面添加(vl-load-com)

应该不是缺少这个，加载后试用还是有该问题

bloodtempt · 发表于 2020-8-14 07:46

cghdy 发表于 2020-8-13 22:49
应该不是缺少这个，加载后试用还是有该问题

把你的发上来我看一下

cghdy · 发表于 2020-8-14 09:34

就是使用你发的例子，没有改动。不知道是不是使用方法不对。

bloodtempt · 发表于 2020-8-14 10:19

"AcDbText"改成"*Text"试试，AcDbText是天正文字

Zrrrrr · 发表于 2021-6-5 13:02

下载试用了下，只能点选，没法框选

dlfjdy · 发表于 2021-6-6 19:49

这个跟飞诗的差不多啊

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

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

本帖子中包含更多资源