明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 2250|回复: 37

[源码] my快速选择,不完美,但简单,绝大部分场景通用

  [复制链接]
发表于 2021-4-9 20:28 | 显示全部楼层 |阅读模式
本帖最后由 wzg356 于 2022-6-10 20:14 编辑

;20220513贴出升级货,一直感觉很好用,下载文件在底部
;20220610优化选快缺陷-更新

;表写对话框输出选项参数
(defun SSSfilter(lst / file f i name id dd key keys key0 keys0 kvs)
        (setq file (vl-filename-mktemp "temp.dcl") f (open file "w"))
        (write-line "MY_SSS: dialog{label=\"快速选择\";" f)
        (write-line " :boxed_column{ label=\"过滤选项   值\";" f)
        (setq I -1)
        (foreach name lst
                (setq keys(cons(setq key(strcat "KEY"  (itoa (setq I (1+ I)))))keys))
                (write-line (strcat ":toggle{label=\"" name "\";key=\"" key "\";value=0;}")f)                        
    )
    (write-line "}" f)
    (write-line ":row{: button{label = \"范围过滤\";key = \"button1\";}" f)
    (write-line "      : button{label = \"全图过滤\";key = \"button2\";}}" f)
    (write-line ":row{: button{label = \"重选样本\";key = \"button3\";}" f)
    (write-line "             cancel_button;}}" f)
    (close f)
    (setq keys(reverse keys) key0(car keys)keys0(cddddr(cddr keys)))
    (setq id (load_dialog file))        
    (new_dialog "MY_SSS" id)        
    (set_tile (car keys) "1")(set_tile (cadr keys) "1")(set_tile (caddr keys) "1")
    (mode_tile "button1" 2)
    (foreach key keys
            (if(= key key0)
                    (action_tile key
                            (strcat "(if(= $value \"1\")"
                                        "(if keys0(mapcar '(lambda(x)(mode_tile x 0)) keys0))"
                                        "(if keys0(mapcar '(lambda(x)(set_tile x \"0\")(mode_tile x 1)) keys0)))"
                                        "(mode_tile \"button1\" 2)"
                            );只有勾选类型keys0才有效
                        )
                        (action_tile key "(mode_tile \"button1\" 2)")
                );button1永为焦点,回车可用
        )
    (action_tile "button1" "(setq kvs(mapcar 'get_tile keys))(done_dialog 1)")
    (action_tile "button2" "(setq kvs(mapcar 'get_tile keys))(done_dialog 2)")
    (action_tile "button3" "(done_dialog 3)")
    (setq dd(start_dialog))
    (unload_dialog Id)(vl-file-delete file)
    (cond
            ((= dd 1)(cons "" kvs))
            ((= dd 2)(cons "x" kvs))
            ((= dd 3)(c:myQSELECT)nil)
            (t nil)
        )
);end -defun
;根据模板对象设置过滤表
(defun outSSfilterls (e / es e0 l1 l2 l3 str as x y a b v )
    (setq es (entget e) e0 (cdr (assoc 0 es)))        
    (setq l1 '((6 . "线型 =")(62 . "颜色 =")(8 . "图层 =")(0 . "类型 =")))
    (cond            
            ((= e0 "INSERT")(setq l1 (cons '(43 . "Z比例 =")(cons '(42 . "Y比例 =")(cons '(41 . "X比例 =")l1)))))
            ((= e0 "HATCH")(setq l1(cons '(52 . "填充角度 =")(cons '(41 . "填充比例 =")(cons '(2 . "图案名 =")l1)))))            
            ((= e0 "ATTDEF")(setq l1 (cons '(2 . "属性标记 =")l1)))
            ((= e0 "DIMENSION")(setq l1(cons '(70 . "标注类型 =")l1)))
            (t nil)
        )
        (if (not (assoc 62 es))(setq es (append es(list '(62 . 256)))))
    (if (not (assoc 6 es))(setq es (append es(list '(6 . "ByLayer")))))
    (setq e(vlax-ename->vla-object e))
    (setq as (list            
            (cons 'Lineweight "线宽 =")
            (cons 'LinetypeScale "线型比例 =")            
            (cons 'StyleName "样式名称 =")            
            (cons 'Height (if (wcmatch e0 "*TEXT,ATTDEF") "文字高度 =" "高度 ="))
            (cons 'Rotation "旋转角度 =")            
            (cons 'Closed "闭合性 =")
            (cons 'ConstantWidth "全局宽度 =")            
            (cons 'Radius "半径 =")            
            (cons 'ScaleFactor (if (wcmatch e0 "TEXT") "宽度因子 =" "全局比例 ="))
            (cons 'area "面积 =")
            (cons 'length "长度 =")
            (cons 'TextString "文字内容 =")
            (cons 'EffectiveName "块名 ="));块用这种方式更好
        )
    (foreach x as
            (setq v(vl-catch-all-apply '(lambda(a b)(Vlax-Get a b))(list e (car x))))
            (if (not(vl-catch-all-error-p v))
                    (setq l1(cons x l1) es(append es(list (cons (car x) v))))
                )            
    )   
    (setq l2 nil l3 nil)
    (foreach x l1
            (and(setq y (assoc (car x) es))
                    (setq l3(cons y l3))
                    (setq str (strcat (cdr x)(vl-princ-to-string(cdr y))))
                    (cond
                    ((and(= e0 "MTEXT")(= (car x) 'TextString))(setq l2(cons "文字内容 =......" l2)))
                    ((and(= e0 "TEXT")(= (car x) 'TextString))(setq l2(cons (substr str 1 30) l2)))
                    ((and(= e0 "DIMENSION")(= (car x) 70))
                            (setq l2(cons(strcat (cdr x)
                                    (nth(apply 'max(mapcar '(lambda(i)(logand i (cdr y)))(list 0 1 2 3 4 5 6)))
                                        (list "转角" "对齐" "角度" "直径" "半径" "三点角度" "坐标")))l2))
                        )                                            
                        (t(setq l2(cons str l2)))
                        )
                )
    )      
    (if  (and l2 (setq l2(SSSfilter l2))
                    (setq l3(vl-remove-if '(lambda(x)(= x nil))(mapcar '(lambda(x y)(if(= x "1")y)) (cdr l2) l3)))
                )
                (cons (car l2) l3)
    )   
)

(defun MYQSELECT(e / propss fls x l as a ss oldGrips)        
        (defun propss(ss prop v fuz / n ss0 e ob v1)
                (and ss (setq ss0(ssadd) n -1)
                        (repeat (sslength ss)
                                (setq e(ssname ss (setq n(1+ n))) ob(vlax-ename->vla-object e))
                                (setq v1(vl-catch-all-apply '(lambda(a b)(Vlax-Get a b))(list ob prop)))
                                (if (and(not(vl-catch-all-error-p v1))(equal v1 v fuz))(ssadd e ss0))
                        )
                )ss0
        );选择集按属性值过滤 ;ss:选择集 prop:属性 v:属性值 fuz:容差        
        (if        (and(setq fls(outSSfilterls e))(setq x(car fls) fls(cdr fls)))
                (progn
                        (setq as(vl-remove-if '(lambda(a)(numberp (car a)))fls))
                        (setq fls(vl-remove-if '(lambda(a)(not(numberp (car a))))fls))
                        (setq ss(if(= x "x")(ssget "x" fls)(ssget fls)))
                        (mapcar '(lambda(a)(if a(setq ss(propss ss (car a) (cdr a) 1e-4))))as)
                        ;(setq oldGrips (getvar "Grips")) (setvar "Grips" 0)
                        (sssetfirst nil ss)
                        ;(setvar "Grips" oldGrips)
                        (princ (strcat "\n 共选择" (itoa(sslength ss)) "个符合条件对象."))
                )
        )ss
)
(vl-load-com)
;快速选择
(defun c:ss nil(c:myQSELECT))
(defun c:myQSELECT( / e)
        (princ "\n 快速选择,作者wzg356")
        (if(setq e(car(entsel "\n选择样本对象:")))(MYQSELECT e))
        (princ)        
)

本帖子中包含更多资源

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

x

评分

参与人数 7明经币 +6 金钱 +40 收起 理由
ZJKUSO + 20 赞一个!
USER2128 + 1 赞一个!
bssurvey + 1 赞一个!
H123456H + 1 + 20 很给力!
断箭 + 1
xj6019 + 1 很给力!
start4444 + 1 很给力!

查看全部评分

本帖被以下淘专辑推荐:

发表于 2021-4-19 22:37 | 显示全部楼层
不错,有空来试下
回复 支持 1 反对 0

使用道具 举报

发表于 2021-5-27 11:14 | 显示全部楼层
我有一个新的构思,也许我们可以探讨一下咯:
能不能实现这样的功能:
我们框选出一大堆东西,然后弹出一个窗口,把框选到的东西的所有类型都列出在里面(0 = 圖元類型 (Entity Type))。
比如包含了註標 (DIMENSION) 插入圖塊 (INSERT) 引線 (LEADER)
文字 (TEXT) 等。
然后我们勾选其中我们要的,比如我只想要文字和引线,确定之后就保留选择文字和引线,其它都不要。
发表于 2022-6-13 01:25 | 显示全部楼层
本帖最后由 whophy 于 2022-6-13 01:36 编辑

感谢大神回复。我意思是:可以多选或者是勾选对话框做成可编辑的,类似 小菜或者 飞诗选择易 相似。
如:天正  通风或者电气  ,图层有相似之处,风管Duct-【排风、送风、新风】*<标注、边线、中心线、立管……>等,如果可以支持正则,可以一次性选择 【排风】或者 【送风】所以图元。现在需要N次 重复。。。

本帖子中包含更多资源

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

x
发表于 2021-4-9 21:19 | 显示全部楼层
你很伟大 分享了那么多好的代码  
发表于 2021-4-10 09:20 来自手机 | 显示全部楼层
顶一个 你的程序都很实用 感谢
发表于 2021-4-17 19:21 | 显示全部楼层
很实用的一个程序  能不能加一个长度选择  加上线的长度 不用管角度的选择
发表于 2021-4-17 21:41 | 显示全部楼层

顶一个 你的程序都很实用 感谢
发表于 2021-4-18 01:32 | 显示全部楼层
我在2008 和 2016使用提示 输入的字符串有缺陷。
发表于 2021-4-18 15:55 | 显示全部楼层
论坛有,小菜选择易,非常不错
发表于 2021-4-19 23:44 来自手机 | 显示全部楼层
谢谢大侠分享代码!
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2022-6-30 15:51 , Processed in 0.186774 second(s), 28 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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