明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 8763|回复: 73

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

    [复制链接]
发表于 2022-5-4 12:14:23 | 显示全部楼层 |阅读模式
本帖最后由 1028695446 于 2022-5-12 22:19 编辑

;;说明:带关键字的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文件缺少的主程序见本帖隐藏内容↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑





本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
发表于 2022-5-23 16:07:38 来自手机 | 显示全部楼层
本帖最后由 pxt2001 于 2022-5-23 16:08 编辑

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

点评

估计解决不了。(vla-sendcommand *doc* (Pt2Str (cadr (grread t))))是必须的。  发表于 2022-9-21 14:32
发表于 2024-6-16 10:08:21 | 显示全部楼层
这个下下来学习一下,期待更加完善的板本
发表于 2022-5-10 16:58:11 | 显示全部楼层
一直在用飞诗的源码,学习一下如何优化的
发表于 2022-5-4 21:06:07 | 显示全部楼层
一直在用飞诗的源码,学习一下如何优化的
发表于 2022-5-5 09:12:16 | 显示全部楼层
学习一下如何优化的
发表于 2022-5-5 18:08:11 | 显示全部楼层
看起来很不错哦,收藏之~~~
谢谢LZ啦!!!
发表于 2022-5-5 23:13:36 | 显示全部楼层
学习一下支持
发表于 2022-5-6 01:20:09 来自手机 | 显示全部楼层
学习一下,来看看
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-12-28 15:46 , Processed in 0.310277 second(s), 26 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表