关于选择易、快选之探索

尘缘一生 · 发表于 2022-8-1 04:16:50

本帖最后由尘缘一生于 2022-8-1 05:31 编辑

选择易，快选，是常规开发，在本坛前辈基础之上，作下整合，
http://bbs.mjtd.com/forum.php?mo ... =%D1%A1%D4%F1%D2%D7
http://bbs.mjtd.com/forum.php?mo ... hlight=%D1%A1%D4%F1

其他大师帖子就不一一列举了。

怎么使用，才能更好呢，我进行了改造与探索，为工作级别使用，集成在《三领设计》
下面贴上集成代码，因为涉及嵌套太多，贴不上全部，不能独立运行，特此说明。

三领从不会照抄照搬源代码进行整合，特此说明，当然，代码不好，也不能入三领的。三领追求快速、好用、都会用。

我为画图而为，图纸为我展现之美。。。。

链接：https://pan.baidu.com/s/1e9sE0g3zAE1x7sRGk0Wi7A
提取码：m98i

;;选择易【开始】--------
(defun c:slszy (/ K00)
(setq k00 (sl:do1ordo3 "三领快选 V2.0" "快选" "->选择易" "常规"))
(cond
((= k00 "常规")
(setq ss (ssget ":S"))
(ss-open-ch ss)
)
((= k00 "快选")
(setq ss (sl-fs-ss t))
)
((= k00 "->选择易")
(if (null c:slxzy)
(load (strcat (slpath sl-path0) "\\实用程序\\" "slxzy.vlx"))
)
(vla-sendcommand *AcDocument* "slxzy ")
)
)
)
;;选择集弹窗处理-----（一级）-----
;ss 选择集
(defun ss-open-ch (ss / dcl_id re tp entPtLst ss1 i enam ptmid wxt-sstr czpath pmid oldfiledia c_num xk zg)
(if ss
(progn
(setq dcl_id (load_dialog (sl_xzy)))
(new_dialog "xzy" dcl_id)
(action_tile "1" "(done_dialog 1)")
(action_tile "2" "(done_dialog 2)")
(action_tile "3" "(done_dialog 3)")
(action_tile "4" "(done_dialog 4)")
(action_tile "5" "(done_dialog 5)")
(action_tile "6" "(done_dialog 6)")
(action_tile "7" "(done_dialog 7)")
(action_tile "8" "(done_dialog 8)")
(action_tile "9" "(done_dialog 9)")
(action_tile "10" "(done_dialog 10)")
(action_tile "11" "(done_dialog 11)")
(action_tile "12" "(done_dialog 12)")
(action_tile "13" "(done_dialog 13)")
(action_tile "14" "(done_dialog 14)")
(action_tile "15" "(done_dialog 15)")
(action_tile "cancel" "(done_dialog 0)")
(setq re (start_dialog))
(slunloaddcl dcl_id)
(cond
((= re 1) ;标记
(setq entPtLst '()) ;;构造空表
(repeat (setq i (sslength ss))
(setq enam (ssname ss (setq i (1- i))))
(if (setq ptmid (e-mid enam))
(setq entPtLst (cons ptmid entPtLst))
)
)
(setq wxt-sstr (strcat (slmsg "共标记了" "共標記了") (itoa (length entPtLst)) "个"))
(command "ZOOM" "E")
(dynamicMTxt wxt-sstr (* 20.0 slbl) entPtLst)
)
((= re 2) ;; 变参照
(setq czpath (strcat (getvar "DWGPREFIX") "-参照" (slsjqs) ".DWG"))
(setq pmid (ssmpt ss))
(command "-wblock" czpath "" pmid ss "")
(setq oldfiledia (getvar "filedia"))
(setvar "filedia" 0)
(command "-XREF" "A" czpath pmid 1 1 0)
(setvar "filedia" oldfiledia)
)
((= re 3)
(d-mov-cop ss nil nil)
)
((= re 4)
(d-mov-cop ss t nil)
)
((= re 5)
(SL:-Erase ss)
)
((= re 6) ;;移层
(ent2lay ss)
)
((= re 7) ;; 变块
(SL-SB ss)
)
((= re 8) ;; 换色
(setq c_num (sl-c-num 1))
(slchcol ss c_num)
)
((= re 9) ;; Z->0
(zzz0 ss)
)
((= re 10) ;; 消重
(ssduppe ss)
)
((= re 11) ;; 线宽
(setq xk (atof (inputbox (slmsg "输入改线宽度？" "輸入改線寬度") (slmsg "線寬 " "線寬 ") "0" "12")))
(gx ss xk)
)
((= re 12) ;; 线型
(ent2lty ss)
)
((= re 13) ;; 字高
(setq zg (atof (inputbox (slmsg "输入新字体高度？" "輸入新字體高度") (slmsg "字体高度 " "字體高度 ") "3" "12")))
(ss-ch-z-hi ss zg nil)
)
((= re 14) ;; 统计文字
(setq ss1 (ssadd))
(repeat (setq n (sslength ss))
(setq enam (ssname ss (setq n (1- n))) tp (dxf1 enam 0))
(if (member tp '("TEXT" "MTEXT" "TCH_TEXT" "ATTDEF" "TCH_MTEXT" "TCH_ELEVATION" "TCH_ARROW" "DIMENSION" "MULTILEADER")) ;文字
(ssadd enam ss1)
)
)
(if ss1
(ss-wztj ss1)
(princ "\n 选择中无有文字实体存在。")
)
)
((= re 15) ;; 文字避让
(if (/= (type TextSDodge) 'SUBR) ;如果函数不存在
(progn
(load (strcat (slpath sl-path0) "\\实用程序\\" "文字避让.vlx"))
(TextSDodge ss)
)
(TextSDodge ss)
)
)
)
)
)
)
;========================================
(defun sl_xzy (/ lst_str)
(setq lst_str
(list
"xzy:dialog {"
"label = \"选择易结果处理（已存剪切板）--->\";"
":boxed_column {"
":row {"
":button{key = \"1\"; label = \"标记\";}"
":button{key = \"3\"; label = \"移动\";}"
":button{key = \"4\"; label = \"复制\";}"
":button{key = \"6\"; label = \"移层\";}"
"}"
":row {"
":button{key = \"8\"; label = \"换色\";}"
":button{key = \"7\"; label = \"成块\";}"
":button{key = \"2\"; label = \"成参\";}"
":button{key = \"9\"; label = \"z->0\";}"
"}"
":row {"
":button{key = \"11\"; label = \"线宽\";}"
":button{key = \"12\"; label = \"线型\";}"
":button{key = \"13\"; label = \"字高\";}"
":button{key = \"10\"; label = \"消重\";}"
"}"
"}"
":row {"
":button{key = \"14\"; label = \"统计文字\";}"
":button{key = \"15\"; label = \"文字避让\";}"
":button{key = \"5\";label = \"删除\";}"
":button{label = \"取消\"; key = \"cancel\"; is_cancel = true;}"
"}"
"}"
)
)
(dcl2lisp lst_str)
)
;快选模板对象-->过滤表------------
(defun sloutssfilterls (e / es tp l1 l2 l3 str as x y a b v)
(defun ssslfilter (lst / file f i name id dd key keys key0 keys0 kvs lst1)
(defun dokey12 ()
(and
(= $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)
)
)
;;----------------
(setq file (vl-filename-mktemp "temp.dcl") f (open file "w"))
(write-line "sl_sss: dialog{" f)
(write-line "label = \"三领设计 V2.0 过滤快选 \";" f)
(setq lst1 (list (car lst) (cadr lst) (caddr lst)) lst (cdddr lst))
(write-line ":boxed_row{" f)
(write-line "label = \"通用\";" f)
(setq i -1)
(foreach name lst1
(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 ":boxed_column{" f)
(setq i 2)
(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 ":text {label = \" ->将存剪切板->后续命令->键P调用\" ;}" f)
(write-line ":text {label = \" 直接回车-->常规选择\" ;}" f)
(write-line ":button {label = \"取消\";key = \"cancel\";is_cancel = true;}}" f)
(close f)
(setq keys (reverse keys) key0 (car keys) keys0 (cddddr (cddr keys)))
(setq id (load_dialog file))
(new_dialog "sl_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 "(dokey12)") ;只有勾选类型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)")
(setq dd (start_dialog))
(unload_dialog id)
(vl-file-delete file)
(cond
((= dd 1) (cons "" kvs))
((= dd 2) (cons "x" kvs))
(t nil)
)
)
;;-----------------------------
(setq es (entget e) tp (dxf1 es 0))
(setq l1 '((6 . "线型 =") (62 . "颜色 =") (8 . "图层 =") (0 . "类型 =")))
(cond
((= tp "INSERT") (setq l1 (append '((43 . "Z比例 =") (42 . "Y比例 =") (41 . "X比例 =") (2 . "块名 =")) l1)))
((= tp "HATCH") (setq l1 (append '((52 . "填充角度 =") (41 . "填充比例 =") (2 . "图案名 =")) l1)))
((= tp "ATTDEF") (setq l1 (append '((2 . "属性标记 =")) l1)))
((= tp "DIMENSION") (setq l1 (append '((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 obj (en2obj e))
(setq as
(list
(cons 'Lineweight "线宽 =")
(cons 'LinetypeScale "线型比例 =")
(cons 'StyleName "样式名称 =")
(cons 'Height (if (wcmatch tp "*TEXT,ATTDEF") "文字高度 =" "高度 ="))
(cons 'Rotation "旋转角度 =")
(cons 'Closed "闭合性 =")
(cons 'ConstantWidth "全局宽度 =")
(cons 'Radius "半径 =")
(cons 'ScaleFactor (if (wcmatch tp "TEXT") "宽度因子 =" "全局比例 ="))
(cons 'area "面积 =")
(cons 'length "长度 =")
(cons 'TextString "文字内容 =")
)
)
(foreach x as
(setq v (vl-catch-all-apply '(lambda (a b) (Vlax-Get a b)) (list obj (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 (= tp "MTEXT") (= (car x) 'TextString)) (setq l2 (cons "文字内容 =......" l2)))
((and (= tp "TEXT") (= (car x) 'TextString)) (setq l2 (cons (substr str 1 30) l2)))
((and (= tp "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 (ssslfilter 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)
)
)
;;模版-快选过滤-->返回ss-----（一级）--------
(defun sl-fs-ss-1 (e / propss fls x l as a ss)
;选择集按属性值过滤 ;ss:选择集 prop:属性 v:属性值 fuz：容差
(defun propss (ss prop v fuz / n ss0 e ob v1)
(and ss (setq ss0 (ssadd))
(repeat (setq n (sslength ss))
(setq e (ssname ss (setq n (1- n))) ob (en2obj 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
)
;;--------------------
(if (and (setq fls (sloutssfilterls 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)
)
)
ss
)
;过滤快选返回选择集 ss
;;kk0 弹出开关 t 弹出 nil 不弹出用作函数
(defun sl-fs-ss (kk0 / oldpik e fls enam n tmptxt tcdis slent)
(setq oldpik (getvar "pickfirst"))
(setvar "pickfirst" 0)
(setq tmptxt (readkey (strcat (slpath sl-path0) "\\" "三领设计.INI") "选择易"))
(cond
((= tmptxt nil)
(rwritekey (strcat (slpath sl-path0) "\\" "三领设计.INI") "选择易" "弹出")
(setq tcdis "弹出")
)
((= tmptxt "弹出")
(setq tcdis "弹出")
)
((= tmptxt "关闭")
(setq tcdis "关闭")
)
)
(while (or (= slent nil) (= slent "K") (= slent "C"))
(initget "K C")
(princ (strcat "\n 请选择样板实体(K-弹窗开/ C-弹窗关) -->" "弹窗" (if (= "弹出" tcdis) "：开" "：关")))
(setq slent (entsel (strcat "\n 请选择样板实体(K-弹窗开/ C-弹窗关) -->" "弹窗" (if (= "弹出" tcdis) "：开" "：关"))))
(cond
((= slent "K")
(setq tcdis "弹出")
(rwritekey (strcat (slpath sl-path0) "\\" "三领设计.INI") "选择易" "弹出")
)
((= slent "C")
(setq tcdis "关闭")
(rwritekey (strcat (slpath sl-path0) "\\" "三领设计.INI") "选择易" "关闭")
)
)
)
(setq ss (sl-fs-ss-1 (car slent)))
(if (and (= tcdis "弹出") (= kk0 t))
(ss-open-ch ss)
)
(if ss
(progn
(princ (strcat "\n 共选中了" (itoa (sslength ss)) "个实体【已存入剪切板】-->"))
(clerbord) ;存剪切板
(command "copyclip" ss "")
(setvar "pickfirst" oldpik)
ss
)
(princ "\n 选择中无有实体存在-->")
)
)
;;选择易【结束】---

彳余 · 发表于 2022-8-1 06:34:03

能支持天正就更好了

yshf · 发表于 2022-8-1 09:53:17

谢谢分享

magicheno · 发表于 2022-8-1 22:32:18

感谢大佬分享~

账号		自动登录	找回密码
密码			注册

关于选择易、快选之探索

本帖子中包含更多资源