删除当前空间内除0层以外的其它层

fengyun7000 · 发表于 2019-2-1 17:08:33

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

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

×

本帖最后由 newer 于 2019-2-1 17:17 编辑

;删除除0层以外的其他层
;套用了好多同志们的程序，拼凑而成，在此不谢
;韩建文
(defun c:erase_layer (/ oce al lay_name ss)
(vl-load-com)
(graphscr)
(command "clayer" "0") ;打开解冻解锁所有图层
(vlax-for lay (vla-get-layers
(vla-get-activedocument (vlax-get-acad-object))
)
(cond ((= -1 (vlax-get lay 'lock)) (vlax-put lay 'lock 0)))
(cond ((= -1 (vlax-get lay 'freeze)) (vlax-put lay 'freeze 0)))
(cond ((= -1 (vlax-get lay 'LayerOn)) (vlax-put lay 'LayerOn 0)))
) ;(setq al (entsel "\n选择所要删除图层上的对象"))
(setq layer_lst (getlayers))
(setq i 0)
(repeat (length layer_lst)
(setq lay_name (nth i layer_lst)) ;(setq lay_name (cdr (assoc 8 (entget (car al)))))
(setq ss (ssget "X" (list (cons 8 lay_name))))
(command "_.erase" ss "")
(if (and (/= "0" lay_name) (/= (getvar "clayer") lay_name))
(command "_purge" "la" lay_name "n")
)
(setq i (+ i 1))
) ;end repeat
) ;end fun
;统计图层数目列表
(defun getlayers (/ layername lst d)
(setq d (tblnext "layer" t)
lst nil
)
(while d
(setq layername (cdr (assoc 2 d)))
(setq lst (append lst (list layername)))
(setq d (tblnext "layer"))
) ;end while
lst
) ;end fun

;删除除0层以外的其他层 
;套用了好多同志们的程序，拼凑而成，在此不谢 
;韩建文 
(defun c:erase_layer (/ oce al lay_name ss) 
  (vl-load-com) 
  (graphscr) 
  (command "clayer" "0")                ;打开解冻解锁所有图层 
  (vlax-for lay (vla-get-layers 
                  (vla-get-activedocument (vlax-get-acad-object)) 
                ) 
    (cond ((= -1 (vlax-get lay 'lock)) (vlax-put lay 'lock 0))) 
    (cond ((= -1 (vlax-get lay 'freeze)) (vlax-put lay 'freeze 0))) 
    (cond ((= -1 (vlax-get lay 'LayerOn)) (vlax-put lay 'LayerOn 0))) 
  )                                     ;(setq al (entsel "\n选择所要删除图层上的对象")) 
  (setq layer_lst (getlayers)) 
  (setq i 0) 
  (repeat (length layer_lst) 
    (setq lay_name (nth i layer_lst))   ;(setq lay_name (cdr (assoc 8 (entget (car al))))) 
    (setq ss (ssget "X" (list (cons 8 lay_name)))) 
    (command "_.erase" ss "") 
    (if (and (/= "0" lay_name) (/= (getvar "clayer") lay_name)) 
      (command "_purge" "la" lay_name "n") 
    ) 
    (setq i (+ i 1)) 
  )                                     ;end repeat 
)                                       ;end fun 
                                        ;统计图层数目列表 
(defun getlayers (/ layername lst d) 
  (setq d   (tblnext "layer" t) 
        lst nil 
  ) 
  (while d 
    (setq layername (cdr (assoc 2 d))) 
    (setq lst (append lst (list layername))) 
    (setq d (tblnext "layer")) 
  )                                     ;end while 
  lst 
)                                       ;end fun

newer · 发表于 2019-2-1 17:20:50

(getlayers)完全可以不用
你在

(vlax-for lay (vla-get-layers
(vla-get-activedocument (vlax-get-acad-object))
)
....
)
这个循环里面，就可以做(getlayers)的工作。

marting · 发表于 2019-2-1 17:45:32

本帖最后由 marting 于 2019-2-1 23:02 编辑

可以改成这样

(defun c:erase_layer (/ oce al lay_name ss layer_lst) (vl-load-com)
(graphscr)
(setvar "clayer" "0")
(setvar "cmdecho" 0)
(setq layer_lst "")
(vlax-for lay (vla-get-layers
(vla-get-activedocument (vlax-get-acad-object))
)
(setq name (vla-get-name lay))
(if (/= name "0")
(progn (setq layer_lst (strcat name "," layer_lst))
(and (= :vlax-true (vlax-get lay 'lock)) (vlax-put lay 'lock :vlax-false))
(and (= :vlax-true (vlax-get lay 'freeze)) (vlax-put lay 'freeze :vlax-false))
(and (= :vlax-false (vlax-get lay 'LayerOn))
(vlax-put lay 'LayerOn :vlax-true)
)
)
)
)
(and (setq ss (ssget "x" (list (cons 8 layer_lst))))
(command "_.erase" ss "")
)
(command "purge" "a" "" "n")
(princ)
)

naruto018 · 发表于 2019-2-1 22:51:59

有个疑惑能帮解一下
像是其中
(and (= -1 (vlax-get lay 'lock)) (vlax-put lay 'lock 0))
跟直接(vlax-put lay 'lock 0)相比
后者会有什么不好的地方或是问题

marting · 发表于 2019-2-1 22:54:00

naruto018 发表于 2019-2-1 22:51
有个疑惑能帮解一下
像是其中
(and (= -1 (vlax-get lay 'lock)) (vlax-put lay 'lock 0))

(and (= -1 (vlax-get lay 'lock)) (vlax-put lay 'lock 0))

就相当于：
(if (= -1 (vlax-get lay 'lock))
(vlax-put lay 'lock 0)
)

naruto018 · 发表于 2019-2-1 23:01:34

marting 发表于 2019-2-1 22:54
(and (= -1 (vlax-get lay 'lock)) (vlax-put lay 'lock 0))

就相当于：

我的意思是比起先判断后(vlax-get lay 'lock)
再确定执行(vlax-put lay 'lock 0)
跟直接执行(vlax-put lay 'lock 0)
的差异

marting · 发表于 2019-2-1 23:03:42

本帖最后由 marting 于 2019-2-1 23:06 编辑

naruto018 发表于 2019-2-1 23:01
我的意思是比起先判断后(vlax-get lay 'lock)
再确定执行(vlax-put lay 'lock 0)
跟直接执行(vlax-put ...

直接解冻、解锁也行
我是从他代码修改的
判断是GET,一般GET要比PUT快些，如果没冻结的，不执行PUT，能快一丢丢

naruto018 · 发表于 2019-2-1 23:12:08

marting 发表于 2019-2-1 23:03
直接解冻、解锁也行
我是从他代码修改的
判断是GET,一般GET要比PUT快些，如果没冻结的，不执行PUT，能 ...

感谢marting大的解答

zhystar · 发表于 2019-2-2 07:45:15

感觉手动删除也挺快的啊

fengyun7000 · 发表于 2019-2-2 08:12:18

marting 发表于 2019-2-1 17:45
可以改成这样

改的更简洁啦，谢谢啦，我就是半路出家，四处拼凑，只能以达到目的为追求

aisong220 · 发表于 2019-2-2 10:08:03

tzfcn · 发表于 2019-2-2 12:11:05

不断改进、不断完善，达到一个更高的水平！

evayleung · 发表于 2019-2-2 12:27:09

谢谢分享、、、、、、、、、、、、、、、、、

coverne · 发表于 2019-2-2 14:38:41

学习学习下

1917732332 · 发表于 2019-2-3 00:20:59

谢谢共享111111

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

[原创] 删除当前空间内除0层以外的其它层

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

评分

点评

点评

点评

点评

点评