[SSGET]带关键字及提示的SSGET

1028695446

;;说明:带关键字的ssget[在Fsxm大神的源码基础上完善]
;;优化内容1：支持(ssget ":E:S")模式
;;优化内容2：完善原程序在先选择后执行情况下，不过滤的bug，
;;参数:Msg:提示信息
;;参数:Kwd:选项关键字（支持多个关键字，如":E:S S",关键字之间用空格隔开，
                   ;其中"S"为额外选项关键字（应摒避CAD内置于SSGET中的关键字）
;;参数:Fil:选集过滤表
;;返回:选集或额外选项关键字
(defun Fsxm-ssget+ (Msg Kwd Fil / Kwd0 pt var stop result *ACAD* *DOC* Fsxm-Split  Pt2Str key_ssget)
        (setq *ACAD*  (vlax-get-acad-object))
        (setq *DOC*   (vla-get-ActiveDocument *ACAD*))
        ;;===============================================================
        ;;点化字串
        (defun Pt2Str (pt)
                (strcat (rtos (car pt) 2 20)
                        ","
                        (rtos (cadr pt) 2 20)
                        ","
                        (rtos (caddr pt) 2 20)
                        "\n"
                )
        )
        ;;===============================================================
        ;;;用分隔符解释字符串成表
        (defun Fsxm-Split (string strkey / po strlst xlen)
                (setq xlen (1+ (strlen strkey)))
                (while (setq po (vl-string-search strkey string))
                        (setq strlst (cons (substr string 1 po) strlst))
                        (setq string (substr string (+ po xlen)))
                )
                (reverse (cons string strlst))
        )
        ;;===============================================================
        (defun Fsxm-entsel (msg filter)
                (setq enp (entsel msg))
                (if (or (= (type enp) 'str)
                                        (and enp (ssget (cadr enp) filter));;点选
                                )
                        enp
                )
        )
        ;;===============================================================
        (cond
                ((cadr (ssgetfirst)) (command "SELECT" (cadr (ssgetfirst)) "") (setq result (ssget "P" Fil)));;优化内容2：完善原程序在先选择后执行情况下，不过滤的bug，
                (t
                        (setq Kwd0 "W L C BOX ALL F WP CP G A R M P U AU SI")
                        (setq kwd (strcase kwd))
                        (setq kwd_lst (Fsxm-Split kwd " "))
                        (initget (strcat Kwd0 " " kwd))
                        (setq var (fsxm-entsel Msg Fil))
                        (if (OR (member "SI" kwd_lst)(member ":S" kwd_lst));;优化内容1：支持(ssget ":E:S")模式
                                (if (and var (listp var))
                                        (progn
                                                (setq stop T)
                                                (setq result(ssadd (car var)))
                                        )
                                )
                        )
                        (if (NOT stop)
                                (cond
                                        ((and
                                                 (listp var);;说明Fsxm-entsel空选
                                                 (/= 52 (getvar "errno"))
                                         )
                                                (vla-sendcommand *doc* (Pt2Str (cadr (grread t))))
                                                (setq key_lst(list ":E" "M" ":S" "SI" ":E:S" ":S:E" ":L"))
                                                (foreach x kwd_lst
                                                        (if (member x key_lst)
                                                                (cond
                                                                        ((or(= x ":E")(= x "M"))(setq  key_ssget        ":E"))
                                                                        ((or(= x ":S")(= x "SI"))(setq key_ssget        ":S"))
                                                                        ((or(= x ":E:S")(= x ":S:E")(= x ":L"))(setq key_ssget        x))
                                                                )
                                                        )
                                                )
                                               (if key_ssget
                                                        (setq result (ssget key_ssget Fil))
                                                        (setq result (ssget  Fil))
                                                )  ;;更新修正2022.5.12                     
                                        );;空选之后变框选
                                        ((member var (fsxm-split Kwd0 " "))
                                                (vla-sendcommand *doc* (strcat var "\n"))
                                                (setq result (ssget Fil))
                                        );响应用户手动输入的关键字（选择模式）
                                        (t (setq result var))
                                )
                        )
                )
        )
        result
)

;;===============================================================
(defun C:TT()
        (setq ss (Fsxm-ssget+ "\n请选择框选文字[或设置(S)连续点选模式]" "S :S" '((0 . "*LEADER"))))
        (cond
                ((= (type ss) 'PICKSET)
                        (sssetfirst nil ss)
                )
                (t (princ ss))
        )
)

;;↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑附件lsp文件缺少的主程序见本帖隐藏内容↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑

wzg356

pxt2001 发表于 2022-5-23 16:07
飞诗寻梦的原版，当选择对象时命令行有一串奇怪的字符，不知道楼主解决了此问题没有

那是cad自身ssget的关键字---kwd0的那些即默认执行，自设的额外加在后面
如去掉，则自设的关键字与kwd0分别设变量即可

核心是：采用entsel解决提示信息和获取关键字，之后用grread获取坐标解决空选后下一步框选问题。

wzg356

sjm689 发表于 2025-2-21 20:00
请问 点化字符串的时候 rtos的精度为什么要设置那么高 是有什么作用吗

这是(cadr (grread t))= (x y z) 转换"(x y z) " 再转表使用的过程，转换尽量接近最初取得的精度

pxt2001

飞诗寻梦的原版，当选择对象时命令行有一串奇怪的字符，不知道楼主解决了此问题没有

liufii

学习一下！

ynpxqjlb

学习一下！！！！！

20060510412

一直在用飞诗的源码，学习一下如何优化的

bai2000

学习一下如何优化的

lxl217114

谢谢分享

zz159504

看起来很不错哦，收藏之~~~
谢谢LZ啦！！！

xj6019

谢谢分享

LIULISHENG

学习一下支持

jxy308

学习一下，来看看