- 积分
- 13477
- 明经币
- 个
- 注册时间
- 2019-3-22
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
本帖最后由 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
评分
-
查看全部评分
|