CAD中实现部分对象隐藏、部分显、全部显示源码
看到有人要部分显示物体，部分隐藏物体，全部显示的程序，现发一个,不知对大家有没有用。收集于明经一大侠，名字记不得了，取之于明，用之于民。*************************************************************************;;; 命令: VB, VQ
;;; 功能: VB 部分隐藏选中的物体，VQ 全部显示所有物休。
;;; 备注: 放样时用得较多
*************************************************************************
;;快速隐藏物体
(vl-load-com)
;对象显示与隐藏
(defun obj_onf (ss mode)
(if (= (type ss) 'PICKSET)
(vlax-for OBJ (vla-get-activeselectionset
(vla-get-activedocument (vlax-get-acad-object))
)
(if (/=(vla-get-visible OBJ) mode) (vla-put-visible OBJ mode))
)
)
)
;图层显示与隐藏
(defun lay_onf (LayName mode)
(if (= (type LayName) 'STR)
(vlax-for lay (vla-get-layers
(vla-get-activedocument (vlax-get-acad-object))
)
(if (eq (strcase (vla-get-name lay)) (strcase LayName))
(if(/=(vla-get-layeron lay) mode)
(vla-put-layeron lay mode)
)
)
)
)
)
;;;把选择集的物体转化为Lisp 图元表
(defun S2L:ENT (ss / i l objs)
(setq i -1 l (sslength ss) objs nil)
(repeat l
(setq objs (cons(ssname ss (setq i (1+ i))) objs))
)
)
;;;把选择集的物体转化为VLisp 图元表
(defun S2V:ENT (ss / i l objs)
(setq i -1 l (sslength ss) objs nil)
(repeat l
(setq objs (cons(vlax-ename->vla-object (ssname ss (setq i (1+ i)))) objs))
)
)
;__
;;全部显示
(defun C:VQ (/ OBJ lay)
(princ "【全部显示】")
(obj_onf (ssget "x") :vlax-true)
(vlax-for lay(vla-get-layers
(vla-get-activedocument (vlax-get-acad-object))
)
(if(/= (vla-get-layeron lay) :vlax-true)
(vla-put-layeron lay :vlax-true)
)
)
(princ)
)
;;部分隐藏
(defun C:VB (/ OBJ)
(princ "【部分隐藏】")
(obj_onf (ssget) :vlax-false)
(princ)
)
;;部分显示
(defun C:vw (/ S2L:ENT ss ssent )
(princ "【部分显示】")
(setq ss (ssget "x")
ssent (ssget)
ssent (S2L:ENT ssent)
)
(foreach s ssent (setq ss (ssdel s ss)))
(setq ss (mapcar 'vlax-ename->vla-object (S2L:ENT ss)))
(foreach s ss (vla-put-visible s :vlax-false))
(princ)
)
(defun C:vw (/ S2L:ENT ss ssent )改为(defun C:vw (/ss ssent )
[*](defun c:xs ( / en ss i ent lx a);选择隐藏相同高度的文字
[*](setq en (ssname (ssget) 0));选择第一个文字
[*](setq ss (ssget "x" (list '(0 . "*text")
[*] (-4 . "<and")
[*] (-4 . "<")(assoc 40 (entget en))
[*] (-4 . ">")(assoc 40 (entget en))
[*] (-4 . "and>")
[*] )
[*] )
[*]);文字高度
[*];(setq ss (ssget "x" (list '(0 . "*text") (assoc 1 (entget en)))));文字内容
[*](setq i 0)
[*](repeat (sslength ss)
[*] (setq sn (ssname ss i))
[*] (setq ent (entget sn))
[*] (setq lx (cdr (assoc 60 ent)))
[*] (if(= lx nil)
[*] (progn
[*] (setq a (list (cons 60 1)))
[*] (setq ent (append ent a))
[*] (entmod ent)
[*] )
[*] )
[*] (if(/= lx nil)
[*] (progn
[*] (setq ent (subst (cons 60 1) (assoc 60 ent) ent))
[*] (entmod ent)
[*] )
[*] )
[*] (setq i (1+ i))
[*] )
[*](princ)
[*])
[*]上面的出错，怎么改成仅显示选择的文字高度的文字，其他都隐藏，谢谢
我只是个搬砖的菜鸟
(defun c:tt()
(if (ssget "i")
(progn
(princ"\n 移动鼠标隐藏对象，任何按键则隔离对象(Esc取消)")
(if (= (X-X 2) "移动鼠标") (_tt) (_tg) )
)
(_tf)
) )
(defun _tt(/ ss ssn n)
(setq ss (ssget "p"))
(command "undo" "be")
(setvar "cmdecho" 0)
(setq n 0)
(while (< n (sslength ss))
(setq ssn (ssname ss n))
(setq ssn (entget ssn))
(setq ssn (append ssn '((60 . 1))))
(entmod ssn)
(setq n (1+ n)) )
(command "undo" "e")
(princ))
;隔离选定对象
(defun _tg(/ ss i sn ent lx a )
(setvar "cmdecho" 0)
(setq ss (ssget "i"))
(command "SELECT" "ALL" "R" ss "")
(setq ss (ssget "P"))
(setq i 0)
(repeat (sslength ss)
(setq sn (ssname ss i))
(setq ent (entget sn))
(setq lx (cdr (assoc 60 ent)))
(if (= lx nil) (progn
(setq a (list (cons 60 1)))
(setq ent (append ent a))
(entmod ent)))
(if (/= lx nil)
(progn
(setq ent (subst (cons 60 1) (assoc 60 ent) ent))
(entmod ent)
) )
(setq i (1+ i)) )
(princ))
;全部取消隐藏
(defun _tf(/ ss ssn n)
(setq ss (ssget "x" (list (cons 60 1))))
(command "undo" "be")
(setvar "cmdecho" 0)
(setq n 0)
(while (< n (sslength ss))
(setq ssn (ssname ss n))
(setq ssn (entget ssn))
(setq ssn (subst (cons 60 0) (assoc 60 ssn) ssn))
(entmod ssn)
(setq n (1+ n)))
(command "undo" "e")
(princ))
;选项，通过返回的键值执行相应的动作
;xvjiex 2020-8-15 http://bbs.mjtd.com/thread-182077-1-1.html
(defun X-X(jl / loop gr aj jp pt)
(if (or(= jl "")(not jl)) (setq jl 0.011) (setq jl (/ jl 100.0)) )
(setq loop t pt (cadr (grread *)))
(while loop
(vl-cmdf "delay" 20)
(setq gr (grread t 8) aj (car gr) jp (cadr gr) )
(cond
((= aj 3) (setq loop nil) (setq aj "左键") )
((= aj 25) (setq loop nil) (setq aj "右键") )
((= aj 5) (if(>(distance pt jp) (*(getvar'viewsize)jl)) (setq loop nil aj "移动鼠标") ) )
)
)
aj
) 明经好人就是多！ 好人就是多 感谢 donghuidong2003 分享程序! 收藏了。谢谢 收藏！和以前的对比学习下区别 太神奇了，这到底是啥原理呢？ 确实好人品使用中 不知道和版主写的一不一样.还是和2015自带的一样?明天试试 留个印记明天看看