社区 › 源码共享 › 带关键字的ssget，个人修改版，可自定义函数进行后续操作

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

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

本帖最后由 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:07

提示vla-object nil

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
)

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

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

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

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

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

前面添加(vl-load-com)

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

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

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

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

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

把你的发上来我看一下

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

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

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

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

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

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

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

这个跟飞诗的差不多啊

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