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

KO你

KO你 发表于 2021-12-14 21:31
这个是在论坛找到的，如果有高手把这个合并成一个命令就好了，只需要TT就可以选对象隐藏，空选则显示全部， ...

任意键包含  空格、回车、字母、数字、符号、鼠标左右键等
快捷键  tt  隐隔显
(defun c:tt (/ ss key)
(princ "\n按<G>隔离; 按<任意键>隐藏; 空选则显示全部隐藏对象 :")
(setq ss (ssget))
(if ss
(progn
(princ "\n按<G>隔离; 按<任意键>隐藏; 空选则显示全部隐藏对象 :")
(setq key (grread))
(cond
((or (= (cadr key) 103) (= (cadr key) 71))
(princ "\n按G隔离对象")(c:tt-g ss))
(t (princ "\n按任意键隐藏对象")(c:tt-t ss))))
(progn (princ "\n空选则显示全部隐藏对象")(c:tt-f)))
(princ))
(defun c:tt-t (ss / i ent elist)
(command "undo" "be")
(setvar "cmdecho" 0)
(repeat (setq i (sslength ss))
(setq ent (ssname ss (setq i (1- i)))
elist (entget ent))
(if (setq code60 (assoc 60 elist))
(setq elist (subst (cons 60 1) code60 elist))
(setq elist (append elist (list (cons 60 1)))))
(entmod elist))
(command "undo" "e")
(princ))
(defun c:tt-f (/ ss i ent elist)
(command "undo" "be")
(setvar "cmdecho" 0)
(if (setq ss (ssget "x" '((60 . 1))))
(repeat (setq i (sslength ss))
(setq ent (ssname ss (setq i (1- i)))
elist (entget ent))
(setq elist (subst (cons 60 0) (assoc 60 elist) elist))
(entmod elist)))
(command "undo" "e")
(princ))
(defun c:tt-g (ss / all i ent elist)
(command "undo" "be")
(setvar "cmdecho" 0)
(if (setq all (ssget "x"))
(repeat (setq i (sslength all))
(setq ent (ssname all (setq i (1- i)))
elist (entget ent))
(if (setq code60 (assoc 60 elist))
(setq elist (subst (cons 60 1) code60 elist))
(setq elist (append elist (list (cons 60 1)))))
(entmod elist)))
(repeat (setq i (sslength ss))
(setq ent (ssname ss (setq i (1- i)))
elist (entget ent))
(setq elist (subst (cons 60 0) (assoc 60 elist) elist))
(entmod elist))
(command "undo" "e")
(princ))

Rimford

明经好人就是多！

用户3766035971

好人就是多

yoyoho

感谢 donghuidong2003 分享程序!

dbqtju

收藏了。谢谢

ucuc2003

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

yjc532

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

lzg8877

确实好人品  使用中

hooboxu

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

MENGZE

留个印记明天看看