明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 12655|回复: 42

【过滤选择V3.0】比贱人工具箱5.8按层选择、按层全选更强大,层名可带@#

    [复制链接]
发表于 2019-4-6 02:11:31 | 显示全部楼层 |阅读模式
本帖最后由 1028695446 于 2021-11-10 09:12 编辑

【过滤选择V3.0】比贱人工具箱5.8按层选择、按层全选更强大,层名可带@#



;; 用正则表达式替换字符 by 梁雄啸.2007.7
(defun XD::String:Replace (pat str nstr key / end)  
  (vl-load-com)
  (if (not *xxvbsexp)
    (setq *xxvbsexp (vlax-get-or-create-object "VBScript.RegExp"))
  )
  (vlax-put *xxvbsexp 'Pattern pat)
  (if (not key)(setq key ""))
  (setq key (strcase key))
  (setq keys '(("I"  "IgnoreCase")("G"  "Global")("M"  "Multiline")))
  (mapcar '(lambda(x)
             (if (wcmatch key (strcat "*" (car x) "*"))
               (vlax-put *xxvbsexp (read(cadr x)) 0)
               (vlax-put *xxvbsexp (read(cadr x)) -1)
                                                 ))
                keys)
  (vlax-invoke *xxvbsexp 'replace str nstr)
)
;[功能] 特殊字符处理(用于文字替换等)
;示例(ACET-STR-ESC-WILDCARDS1 "#a@b");"`#a`@b"
;注:没有安装ET时用,安装ET后用(ACET-STR-ESC-WILDCARDS "#a@b")
;;淘贴至自贡黄大师
(defun ACET-STR-ESC-WILDCARDS1 (A / X LST)
  ;(ACET-STR-REPLACE "B" "2" "ssABCsBs");"ssA2Cs2s"
  (defun ACET-STR-REPLACE1 (o n s)
    (XD::String:Replace (strcat "[" o "]") s n "I")
  )
  (SETQ LST '("#" "@" "." "*" "?" "~" "[" "]" ","))
  (foreach X LST
    (SETQ A (ACET-STR-REPLACE1 X (STRCAT "`" X) A))
  )
  A
)


;;-------------------------------------------------------------------------
;过滤选择,DXF组码,by:1028695446
;过滤选择,DXF组码,by:1028695446
(defun FILTER_by_DXF_code(ss DXF_code / ss i filter elist DXF_cons ssf n)
        (if ss
                (progn
                        (command "undo" "be")
                        (setq i 0)
                        (setq filter nil)
                        (repeat (sslength ss)
                                (setq elist(entget (ssname ss i)))
                                (if (assoc DXF_code elist)
                                        (if (=(type(cdr(assoc DXF_code elist))) 'STR)
                                                (setq DXF_cons  (cons DXF_code (ACET-STR-ESC-WILDCARDS1 (cdr(assoc DXF_code elist)))))        
                                                (setq DXF_cons  (assoc DXF_code elist))                                
                                        );;此处有修正
                                        (if(= DXF_code 62)
                                                (setq DXF_cons (cons  DXF_code 256))
                                        );;;只针对颜色为 bylayer 有用
                                );;end if
                                (setq filter (append filter (list DXF_cons)))
                                (setq i (1+ i))
                        );;end repeat
                        (setq filter (append '((-4 . "<or")) filter '((-4 . "or>"))));建立过滤表
                        (princ"\n请框选对象范围<按空格或右键全选>:")
                        (if (setq ssf (ssget filter))
                                (princ)
                                (setq ssf (ssget "x" filter))                                
                        )
                        (command "undo" "e")
                        (sssetfirst nil ssf)
                        (princ)
                )
                (princ"\n未选择,退出")
        )
        (princ)
);;end defun
;;0  按类型过滤
(defun c:xee() (princ "\n过滤选择---类型")(FILTER_by_DXF_code (ssget) 0 ))
;;8  按图层过滤
(defun c:xer() (princ "\n过滤选择---图层")(FILTER_by_DXF_code (ssget) 8 ))
;;62 按颜色过滤
(defun c:xcr() (princ "\n过滤选择---颜色")(FILTER_by_DXF_code (ssget) 62))
;;先选块,然后按块名过滤
(defun c:xzk() (princ "\n过滤选择---块名")(FILTER_by_DXF_code (ssget '((0 . "INSERT"))) 2))
;;先选填充,然后按填充样式过滤
(defun c:xzh() (princ "\n过滤选择---填充名")(FILTER_by_DXF_code (ssget '((0 . "HATCH"))) 2))
;;先选尺寸标注,然后按标注样式过滤
(defun c:xzD() (princ "\n过滤选择---标注样式")(FILTER_by_DXF_code (ssget '((0 . "*DIMENSION"))) 3))
;;先选文字,然后按文字内容过滤
(defun c:xztt()(princ "\n过滤选择---文字内容")(FILTER_by_DXF_code (ssget '((0 . "MTEXT,TEXT"))) 1))
;;先选文字,然后按字体样式过滤
(defun c:xzSt()(princ "\n过滤选择---文字样式")(FILTER_by_DXF_code (ssget '((0 . "MTEXT,TEXT"))) 7))
;;只选文字
(DEFUN C:x1()        (sssetfirst nil (ssget '((0 . "MTEXT,TEXT"))))        (prin1))
;;只选标注+箭头引线
(DEFUN C:x2()        (sssetfirst nil (ssget '((0 . "*DIMENSION,LEADER"))))        (prin1))
;选文字+标注+箭头引线
(DEFUN C:x3()        (sssetfirst nil (ssget '((0 . "MTEXT,TEXT,*DIMENSION,LEADER"))))        (prin1))
;选填充
(DEFUN C:x5()        (sssetfirst nil (ssget '((0 . "hatch"))))        (prin1))

本帖子中包含更多资源

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

x

评分

参与人数 2明经币 +2 金钱 +50 收起 理由
tigcat + 1 很给力!
小万LISP + 1 + 50 很给力!

查看全部评分

本帖被以下淘专辑推荐:

 楼主| 发表于 2019-4-6 14:13:12 | 显示全部楼层
1291500406 发表于 2019-4-6 09:48
图层名为啥要建立@#这种名字的图层

(defun c:bb()(sssetfirst nil (SSGET "X"(LIST '(0 . "*")(assoc 8  ...

对啊,有的人就是有坏习惯,块名和层名不规范,喜欢带#之类号,这个拦不住的,
另外匿名块带*号啊,你这个肯定选不到吧,
由于ssget的过滤方式用的是类似wcmatch采用的是正则表达方式,带*号#号的都被当做替代符处理了
所以必须对块名的字符进行处理,给*和#号加转义字符·
发表于 2021-8-26 14:09:27 | 显示全部楼层
1291500406 发表于 2019-4-6 09:48
图层名为啥要建立@#这种名字的图层

(defun c:bb()(sssetfirst nil (SSGET "X"(LIST '(0 . "*")(assoc 8  ...

你这个需要点选,才能选中图层,能不能不用点选,直接BB某个图层就被选中的
发表于 2020-5-7 16:17:27 | 显示全部楼层
1291500406 发表于 2019-4-6 09:48
图层名为啥要建立@#这种名字的图层

(defun c:bb()(sssetfirst nil (SSGET "X"(LIST '(0 . "*")(assoc 8  ...

短小精干,好用的不得了
发表于 2019-4-6 09:48:11 | 显示全部楼层
本帖最后由 1291500406 于 2019-4-6 11:31 编辑

图层名为啥要建立@#这种名字的图层

(defun c:bb()(sssetfirst nil (SSGET "X"(LIST '(0 . "*")(assoc 8 (entget (car (entsel "按层全选"))))))))



发表于 2019-5-28 12:53:37 | 显示全部楼层
大师,能把贱人工具箱的“前后缀”给弄出来不,那个带记忆,点中就改变,感觉很好用
发表于 2019-11-19 22:41:39 | 显示全部楼层
谢谢楼主分享
发表于 2020-5-7 16:16:52 | 显示全部楼层
这个好用,不错
发表于 2020-5-21 15:38:59 | 显示全部楼层
谢谢分享,精华
发表于 2020-6-3 12:18:27 | 显示全部楼层
太好了  非常感谢分享
发表于 2020-8-24 02:08:35 | 显示全部楼层

请教楼主一个问题,为什么你这个过滤的源码打包进FAS格式,或打包进VLX格式会失效。是什么原因
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-11-22 15:10 , Processed in 0.180199 second(s), 28 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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