CAD中实现部分对象隐藏、部分显、全部显示源码

donghuidong2003

看到有人要部分显示物体，部分隐藏物体，全部显示的程序，现发一个,不知对大家有没有用。收集于明经一大侠，名字记不得了，取之于明，用之于民。

2. *************************************************************************
   
3. ;;; 命令: VB, VQ
   
4. ;;; 功能: VB 部分隐藏选中的物体，VQ 全部显示所有物休。
   
5. ;;; 备注: 放样时用得较多
   
6. *************************************************************************
   
7. ;;快速隐藏物体
   
8. (vl-load-com)
   
9. ;对象显示与隐藏
   
10. (defun obj_onf (ss mode)
    
11.   (if (= (type ss) 'PICKSET)
    
12.     (vlax-for OBJ (vla-get-activeselectionset
    
13.         (vla-get-activedocument (vlax-get-acad-object))
    
14.       )
    
15.       (if (/=(vla-get-visible OBJ) mode) (vla-put-visible OBJ mode))
    
16.     )
    
17.   )
    
18. )
    
19. ;图层显示与隐藏
    
20. (defun lay_onf (LayName mode)
    
21.   (if (= (type LayName) 'STR)
    
22.     (vlax-for lay (vla-get-layers
    
23.         (vla-get-activedocument (vlax-get-acad-object))
    
24.       )
    
25.       (if (eq (strcase (vla-get-name lay)) (strcase LayName))
    
26.   (if(/=(vla-get-layeron lay) mode)
    
27.     (vla-put-layeron lay mode)
    
28.     )
    
29.   )
    
30.     )
    
31.   )
    
32. )
    
33. 
    
34. ;;;把选择集的物体转化为Lisp 图元表
    
35. (defun S2L:ENT (ss / i l objs)
    
36.   (setq i -1 l (sslength ss) objs nil)
    
37.   (repeat l
    
38.     (setq objs (cons  (ssname ss (setq i (1+ i))) objs))
    
39.   )
    
40. )
    
41. ;;;把选择集的物体转化为VLisp 图元表
    
42. (defun S2V:ENT (ss / i l objs)
    
43.   (setq i -1 l (sslength ss) objs nil)
    
44.   (repeat l
    
45.     (setq objs (cons  (vlax-ename->vla-object (ssname ss (setq i (1+ i)))) objs))
    
46.   )
    
47. )
    
48. ;__
    
49. ;;全部显示
    
50. (defun C:VQ (/ OBJ lay)
    
51.   (princ "【全部显示】")
    
52.   (obj_onf (ssget "x") :vlax-true)
    
53.   (vlax-for lay  (vla-get-layers
    
54.       (vla-get-activedocument (vlax-get-acad-object))
    
55.     )
    
56.     (if  (/= (vla-get-layeron lay) :vlax-true)
    
57.       (vla-put-layeron lay :vlax-true)
    
58.     )
    
59.   )
    
60.   (princ)
    
61. )
    
62. ;;部分隐藏
    
63. (defun C:VB (/ OBJ)
    
64.   (princ "【部分隐藏】")
    
65.   (obj_onf (ssget) :vlax-false)
    
66.   (princ)
    
67. )
    
68. ;;部分显示
    
69. (defun C:vw (/ S2L:ENT ss ssent )
    
70.   (princ "【部分显示】")
    
71.   (setq ss (ssget "x")
    
72.         ssent (ssget)
    
73.   ssent (S2L:ENT ssent)  
    
74.   )
    
75.   (foreach s ssent (setq ss (ssdel s ss)))
    
76.   (setq ss (mapcar 'vlax-ename->vla-object (S2L:ENT ss)))
    
77.   (foreach s ss (vla-put-visible s :vlax-false))
    
78.   (princ)
    
79. )
    

*************************************************************************<br /> ;;; 命令: VB, VQ<br /> ;;; 功能: VB 部分隐藏选中的物体，VQ 全部显示所有物休。<br /> ;;; 备注: 放样时用得较多<br /> *************************************************************************<br /> ;;快速隐藏物体<br /> (vl-load-com)<br /> ;对象显示与隐藏<br /> (defun obj_onf (ss mode)<br />   (if (= (type ss) 'PICKSET)<br />     (vlax-for OBJ (vla-get-activeselectionset<br />         (vla-get-activedocument (vlax-get-acad-object))<br />       )<br />       (if (/=(vla-get-visible OBJ) mode) (vla-put-visible OBJ mode))<br />     )<br />   )<br /> )<br /> ;图层显示与隐藏<br /> (defun lay_onf (LayName mode)<br />   (if (= (type LayName) 'STR)<br />     (vlax-for lay (vla-get-layers<br />         (vla-get-activedocument (vlax-get-acad-object))<br />       )<br />       (if (eq (strcase (vla-get-name lay)) (strcase LayName))<br />   (if(/=(vla-get-layeron lay) mode)<br />     (vla-put-layeron lay mode)<br />     )<br />   )<br />     )<br />   )<br /> )<br /> <br /> ;;;把选择集的物体转化为Lisp 图元表 <br /> (defun S2L:ENT (ss / i l objs) <br />   (setq i -1 l (sslength ss) objs nil) <br />   (repeat l <br />     (setq objs (cons  (ssname ss (setq i (1+ i))) objs)) <br />   ) <br /> )<br /> ;;;把选择集的物体转化为VLisp 图元表 <br /> (defun S2V:ENT (ss / i l objs) <br />   (setq i -1 l (sslength ss) objs nil) <br />   (repeat l <br />     (setq objs (cons  (vlax-ename->vla-object (ssname ss (setq i (1+ i)))) objs)) <br />   ) <br /> )<br /> ;__<br /> ;;全部显示<br /> (defun C:VQ (/ OBJ lay)<br />   (princ "【全部显示】")<br />   (obj_onf (ssget "x") :vlax-true)<br />   (vlax-for lay  (vla-get-layers<br />       (vla-get-activedocument (vlax-get-acad-object))<br />     )<br />     (if  (/= (vla-get-layeron lay) :vlax-true)<br />       (vla-put-layeron lay :vlax-true)<br />     )<br />   )<br />   (princ)<br /> )<br /> ;;部分隐藏<br /> (defun C:VB (/ OBJ)<br />   (princ "【部分隐藏】")<br />   (obj_onf (ssget) :vlax-false)<br />   (princ)<br /> )<br /> ;;部分显示<br /> (defun C:vw (/ S2L:ENT ss ssent )<br />   (princ "【部分显示】")<br />   (setq ss (ssget "x")<br />         ssent (ssget)<br />   ssent (S2L:ENT ssent)  <br />   )<br />   (foreach s ssent (setq ss (ssdel s ss)))<br />   (setq ss (mapcar 'vlax-ename->vla-object (S2L:ENT ss)))<br />   (foreach s ss (vla-put-visible s :vlax-false))<br />   (princ)<br /> )<br />

liujing95

(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)
• )
• 上面的出错，怎么改成仅显示选择的文字高度的文字，其他都隐藏，谢谢
  

669423907

我只是个搬砖的菜鸟
(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
)

Rimford

明经好人就是多！

用户3766035971

好人就是多

yoyoho

感谢 donghuidong2003 分享程序!

dbqtju

收藏了。谢谢

ucuc2003

收藏！和以前的对比学习下区别

yjc532

太神奇了，这到底是啥原理呢？

lzg8877

确实好人品  使用中

hooboxu

不知道和版主写的一不一样.还是和2015自带的一样?明天试试

MENGZE

留个印记明天看看