关于选择易、快选之探索
本帖最后由 尘缘一生 于 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 选择中无有实体存在-->")
[*])
[*])
[*];;选择易【结束】---
能支持天正就更好了 谢谢分享 感谢大佬分享~
页:
[1]