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

  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. )


网友答: (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你 于 2025-7-11 02:29 编辑

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))


网友答: 明经好人就是多！

网友答: 好人就是多

网友答: 感谢 donghuidong2003 分享程序!

网友答: 收藏了。谢谢

网友答: 收藏！和以前的对比学习下区别

网友答: 太神奇了，这到底是啥原理呢？

网友答: 确实好人品  使用中

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

网友答: 留个印记明天看看
  • 上一篇：如何制作图名下划线随字符长度变化而变化的块
  • 下一篇：没有了
    CAD技术交流中心 | 建筑CAD | 给排水CAD | 暖通CAD | 电气CAD | 电力CAD | 机械CAD | CAD母线槽 | CAD看图
    Copyright © 2019 - 2025