请求一个关闭块内所有层的工具

Lisphk · 发表于 2013-5-14 09:22:58

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

手里有不少关闭图层的工具，但是对块来说，都关不净，总会留下些实体还能看到，能否给写一个“干净彻底”的关闭图层的命令？

谢谢！

Free-Lancer · 发表于 2013-5-14 09:55:54

这样?

(defun c:tt (/ e obj doc blocks layers)
(while (setq e (car (entsel "\nPick Insert: ")))
(setq obj (vlax-ename->vla-object e))
(if (= (vla-get-objectname obj) "AcDbBlockReference")
(progn
(setq doc (vla-get-activedocument (vlax-get-acad-object))
blocks (vla-get-blocks doc)
layers (vla-get-layers doc)
)
(vl-catch-all-apply
(function
(lambda ()
(vlax-for x (vla-item blocks (vla-get-name obj))
(vla-put-Freeze
(vla-item layers (vla-get-layer x))
:vlax-true
);_Freeze Layer In Block
)
(vla-put-freeze (vla-get-layer obj) :vlax-true);_Freeze Layer of Insert
)
)
)
)
)
)
(if doc
(mapcar 'vlax-release-object (list doc blocks layers))
)
(princ)
)

Lisphk · 发表于 2013-5-14 10:03:51

Free-Lancer 发表于 2013-5-14 09:55
这样?

谢谢eachy大师，能不能帮修改下适合所有情况呢？

对普通实体和块的都适合。

另外，能不能“选层关闭”、“选层冻结”分别写两个命令？谢谢！！

liuyun242 · 发表于 2013-5-14 11:29:21

msteel工具这些功能都有

Free-Lancer · 发表于 2013-5-14 11:46:31

试试这个合二为一的[pcode=lisp,true](defun c:tt (/ lyrf doc blocks layers tf kw mod e obj)
 (defun lyrf (lyr mod)
(vlax-put-property
 lyr
 mod
 (if (= mod 'Freeze)
 :vlax-true
 :vlax-false
 )
)
 )
 (setq doc (vla-get-activedocument (vlax-get-acad-object))
 blocks (vla-get-blocks doc)
 layers (vla-get-layers doc)
 tf t
 kw "F"
 mod 'Freeze
 )
 (vl-catch-all-apply
(function
 (lambda ()
 (while (and
 tf
 (progn
 (initget "Freeze layerOn")
 (setq
 e
 (entsel
 (strcat
 "\n选择物体[F - 冻结/O - 关闭]<"
 kw
 ">: "
 )
 )
 )
 )
 ) ;_end and
(cond
 ((null e) (setq tf nil))
 ((= e "Freeze")
 (setq kw "F"
 mod 'Freeze
 )
 )
 ((= e "layerOn")
 (setq kw "O"
 mod 'LayerOn
 )
 )
 (t)
)
(if (listp e) ;_if pick
 (progn
 (setq obj (vlax-ename->vla-object (car e)))
 (if (= (vla-get-objectname obj)
 "AcDbBlockReference"
 )
(vlax-for x (vla-item blocks (vla-get-name obj))
 (lyrf (vla-item layers (vla-get-layer x)) mod)
) ;_Freeze Layer In Block
 ) ;_end if insert
 (lyrf (vla-item layers (vla-get-layer obj)) mod) ;_Freeze Layer of Object
 ) ;_end progn
) ;_end if
 ) ;_end while
 ) ;_end lambda
) ;_end function
 ) ;_end catch
 (mapcar 'vlax-release-object (list doc blocks layers))
 (princ)
)[/pcode]

Lisphk · 发表于 2013-5-14 12:21:10

Free-Lancer 发表于 2013-5-14 11:46
试试这个合二为一的(defun c:tt (/ lyrf doc blocks layers tf kw mod e obj)
(defun lyrf (lyr mod)
...

谢谢，测试了下，好像图块内实体有在当前层的没作用？能不能修改下代码，判断下当前层，如果好似冻结的话，就先设置当前层为0，然后再冻结，如果关闭，可能代码也要判断下？

另外，
QQ截图20130514121931.png

这个提示好几次我选蒙了，以为冻结是O，能不能这样: [冻结-F/关闭-O]<F> {:soso_e106:}

Lisphk · 发表于 2013-5-14 12:22:28

Free-Lancer 发表于 2013-5-14 11:46
试试这个合二为一的(defun c:tt (/ lyrf doc blocks layers tf kw mod e obj)
(defun lyrf (lyr mod)
...

对了，忘记问了，嵌套块也考虑了吗？

Free-Lancer · 发表于 2013-5-14 14:49:36

本帖最后由 Free-Lancer 于 2013-5-14 18:09 编辑

再试试

(defun c:tt (/ lyrf doc blocks layers tf kw mod e n)
(defun lyrf (obj mod / lyrff)
(defun lyrff (lyr mod)
(vl-catch-all-apply
(function (lambda ()
(vlax-put-property
lyr
mod
(if (= mod 'Freeze)
:vlax-true
:vlax-false
)
)
)
)
)
)
(if (= (vla-get-objectname obj)
"AcDbBlockReference"
)
(vlax-for x (vla-item blocks (vla-get-name obj))
(if (= (vla-get-objectname obj)
"AcDbBlockReference"
)
(lyrf x mod)
)
(lyrff (vla-item layers (vla-get-layer x)) mod)
) ;_Freeze Layer In Block
) ;_end if insert
(lyrff (vla-item layers (vla-get-layer obj)) mod) ;_Freeze Layer of Object
)
(setq doc (vla-get-activedocument (vlax-get-acad-object))
blocks (vla-get-blocks doc)
layers (vla-get-layers doc)
tf t
kw "F"
mod 'Freeze
n 0
)
(setvar "cmdecho" 0)
(vl-catch-all-apply
(function
(lambda ()
(while (and
tf
(progn
(initget "Freeze layerOn U")
(setq
e
(nentsel
(strcat
"\n选择物体[冻结-F/关闭-O/回退-U]<"
kw
">: "
)
)
)
)
) ;_end and
(cond
((null e) (setq tf nil))
((= e "Freeze")
(setq kw "F"
mod 'Freeze
)
)
((= e "layerOn")
(setq kw "O"
mod 'LayerOn
)
)
((= e "U")
(if (zerop n)
(princ "\nAll is Undo!")
(progn
(vl-cmdf ".U") ;_ 撤销不完善
(setq n (1- n))
)
)
)
(t)
)
(vla-startundomark doc) ;_undo mark
(if (listp e) ;_if pick
(cond
((= (length e) 2)
(lyrf (vlax-ename->vla-object (car e)) mod)
(setq n (1+ n))
)
((= (length e) 4)
(mapcar
'(lambda (x) (lyrf (vlax-ename->vla-object x) mod))
(last e)
)
(setq n (1+ n))
)
(t)
) ;_end cond
) ;_end if
(vla-endundomark doc)
) ;_end while
) ;_end lambda
) ;_end function
) ;_end catch
(mapcar 'vlax-release-object (list doc blocks layers))
(princ)
)

(defun c:tt (/ lyrf doc blocks layers tf kw mod e n) 
  (defun lyrf (obj mod / lyrff) 
    (defun lyrff (lyr mod) 
      (vl-catch-all-apply 
 (function (lambda () 
      (vlax-put-property 
        lyr 
        mod 
        (if (= mod 'Freeze) 
   :vlax-true 
   :vlax-false 
        ) 
      ) 
    ) 
 ) 
      ) 
    ) 
    (if (= (vla-get-objectname obj) 
    "AcDbBlockReference" 
 ) 
      (vlax-for x (vla-item blocks (vla-get-name obj)) 
 (if (= (vla-get-objectname obj) 
        "AcDbBlockReference" 
     ) 
   (lyrf x mod) 
 ) 
 (lyrff (vla-item layers (vla-get-layer x)) mod) 
      ) ;_Freeze Layer In Block 
    ) ;_end if insert 
    (lyrff (vla-item layers (vla-get-layer obj)) mod) ;_Freeze Layer of Object 
  ) 
  (setq doc    (vla-get-activedocument (vlax-get-acad-object)) 
 blocks (vla-get-blocks doc) 
 layers (vla-get-layers doc) 
 tf     t 
 kw     "F" 
 mod    'Freeze 
 n      0 
  ) 
  (setvar "cmdecho" 0) 
  (vl-catch-all-apply 
    (function 
      (lambda () 
 (while (and 
   tf 
   (progn 
     (initget "Freeze layerOn U") 
     (setq 
       e 
        (nentsel 
   (strcat 
     "\n选择物体[冻结-F/关闭-O/回退-U]<" 
     kw 
     ">: " 
   ) 
        ) 
     ) 
   ) 
        ) ;_end and 
   (cond 
     ((null e) (setq tf nil)) 
     ((= e "Freeze") 
      (setq kw  "F" 
     mod 'Freeze 
      ) 
     ) 
     ((= e "layerOn") 
      (setq kw  "O" 
     mod 'LayerOn 
      ) 
     ) 
     ((= e "U") 
      (if (zerop n) 
        (princ "\nAll is Undo!") 
        (progn 
   (vl-cmdf ".U") ;_ 撤销不完善 
   (setq n (1- n)) 
        ) 
      ) 
     ) 
     (t) 
   ) 
   (vla-startundomark doc) ;_undo mark 
   (if (listp e) ;_if pick 
     (cond 
       ((= (length e) 2) 
        (lyrf (vlax-ename->vla-object (car e)) mod) 
        (setq n (1+ n)) 
       ) 
       ((= (length e) 4) 
        (mapcar 
   '(lambda (x) (lyrf (vlax-ename->vla-object x) mod)) 
   (last e) 
        ) 
        (setq n (1+ n)) 
       ) 
       (t) 
     ) ;_end cond 
   ) ;_end if 
   (vla-endundomark doc) 
 ) ;_end while 
      ) ;_end lambda 
    ) ;_end function 
  ) ;_end catch 
  (mapcar 'vlax-release-object (list doc blocks layers)) 
  (princ) 
)

Lisphk · 发表于 2013-5-14 21:22:32

Free-Lancer 发表于 2013-5-14 14:49
再试试

太OK了，完美，谢谢eachy大师。大师出手就只有没有。
{:soso_e142:}

Lisphk · 发表于 2013-5-14 21:26:30

liuyun242 发表于 2013-5-14 11:29
msteel工具这些功能都有

我用过很多的工具了，没EACHY大师这个完美，你说的这个工具能完成我上面说的所有要求吗？

14702470 · 发表于 2016-3-28 08:54:01

很好，正在需要，谢谢了

chen7560152 · 发表于 2019-6-27 00:25:19

Free-Lancer 发表于 2013-5-14 14:49
再试试

一直有这个功能的困扰，程序真的很给力，如果是相反的功能，显示块内的所有图层呢该是什么样子的

uualice · 发表于 2019-6-27 19:35:20

正需要，谢谢了

账号		自动登录	找回密码
密码			立即注册

[已解决] 请求一个关闭块内所有层的工具

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

评分