找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 1415|回复: 15

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

[复制链接]

已领礼包: 55个

财富等级: 招财进宝

发表于 2019-2-1 17:08:33 | 显示全部楼层 |阅读模式

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

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

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

  1. ;删除除0层以外的其他层
  2. ;套用了好多同志们的程序,拼凑而成,在此不谢
  3. ;韩建文
  4. (defun c:erase_layer (/ oce al lay_name ss)
  5.   (vl-load-com)
  6.   (graphscr)
  7.   (command "clayer" "0")                ;打开解冻解锁所有图层
  8.   (vlax-for lay (vla-get-layers
  9.                   (vla-get-activedocument (vlax-get-acad-object))
  10.                 )
  11.     (cond ((= -1 (vlax-get lay 'lock)) (vlax-put lay 'lock 0)))
  12.     (cond ((= -1 (vlax-get lay 'freeze)) (vlax-put lay 'freeze 0)))
  13.     (cond ((= -1 (vlax-get lay 'LayerOn)) (vlax-put lay 'LayerOn 0)))
  14.   )                                     ;(setq al (entsel "\n选择所要删除图层上的对象"))
  15.   (setq layer_lst (getlayers))
  16.   (setq i 0)
  17.   (repeat (length layer_lst)
  18.     (setq lay_name (nth i layer_lst))   ;(setq lay_name (cdr (assoc 8 (entget (car al)))))
  19.     (setq ss (ssget "X" (list (cons 8 lay_name))))
  20.     (command "_.erase" ss "")
  21.     (if (and (/= "0" lay_name) (/= (getvar "clayer") lay_name))
  22.       (command "_purge" "la" lay_name "n")
  23.     )
  24.     (setq i (+ i 1))
  25.   )                                     ;end repeat
  26. )                                       ;end fun
  27.                                         ;统计图层数目列表
  28. (defun getlayers (/ layername lst d)
  29.   (setq d   (tblnext "layer" t)
  30.         lst nil
  31.   )
  32.   (while d
  33.     (setq layername (cdr (assoc 2 d)))
  34.     (setq lst (append lst (list layername)))
  35.     (setq d (tblnext "layer"))
  36.   )                                     ;end while
  37.   lst
  38. )                                       ;end fun


评分

参与人数 1D豆 +5 收起 理由
newer + 5 很给力!经验;技术要点;资料分享奖!

查看全部评分

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!

已领礼包: 40个

财富等级: 招财进宝

发表于 2019-2-1 17:20:50 | 显示全部楼层
(getlayers)完全可以不用
你在

(vlax-for lay (vla-get-layers
                  (vla-get-activedocument (vlax-get-acad-object))
                )
   ....
)
这个循环里面,就可以做(getlayers)的工作。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 20个

财富等级: 恭喜发财

发表于 2019-2-1 17:45:32 | 显示全部楼层
本帖最后由 marting 于 2019-2-1 23:02 编辑

可以改成这样

  1. (defun c:erase_layer (/ oce al lay_name ss layer_lst)  (vl-load-com)
  2.   (graphscr)
  3.   (setvar "clayer" "0")
  4.   (setvar "cmdecho" 0)
  5.   (setq layer_lst "")
  6.   (vlax-for lay (vla-get-layers
  7.                   (vla-get-activedocument (vlax-get-acad-object))
  8.                 )
  9.     (setq name (vla-get-name lay))
  10.     (if (/= name "0")
  11.       (progn (setq layer_lst (strcat name "," layer_lst))
  12.              (and (= :vlax-true (vlax-get lay 'lock)) (vlax-put lay 'lock :vlax-false))
  13.              (and (= :vlax-true (vlax-get lay 'freeze)) (vlax-put lay 'freeze :vlax-false))
  14.              (and (= :vlax-false (vlax-get lay 'LayerOn))
  15.                   (vlax-put lay 'LayerOn :vlax-true)
  16.              )
  17.       )
  18.     )
  19.   )
  20.   (and (setq ss (ssget "x" (list (cons 8 layer_lst))))
  21.        (command "_.erase" ss "")
  22.   )
  23.   (command "purge" "a" "" "n")
  24.   (princ)
  25. )

点评

改的更简洁啦,谢谢啦,我就是半路出家,四处拼凑,只能以达到目的为追求  详情 回复 发表于 2019-2-2 08:12
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 166个

财富等级: 日进斗金

发表于 2019-2-1 22:51:59 | 显示全部楼层
有个疑惑能帮解一下
像是其中
(and (= -1 (vlax-get lay 'lock)) (vlax-put lay 'lock 0))
跟直接(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) )  详情 回复 发表于 2019-2-1 22:54
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 20个

财富等级: 恭喜发财

发表于 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)
)

点评

我的意思是比起先判断后(vlax-get lay 'lock) 再确定执行(vlax-put lay 'lock 0) 跟直接执行(vlax-put lay 'lock 0) 的差异  详情 回复 发表于 2019-2-1 23:01
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 166个

财富等级: 日进斗金

发表于 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)
的差异

点评

直接解冻、解锁也行 我是从他代码修改的  详情 回复 发表于 2019-2-1 23:03
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 20个

财富等级: 恭喜发财

发表于 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,能快一丢丢

点评

感谢marting大的解答  详情 回复 发表于 2019-2-1 23:12
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 166个

财富等级: 日进斗金

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

感谢marting大的解答
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 960个

财富等级: 财运亨通

发表于 2019-2-2 07:45:15 | 显示全部楼层
感觉手动删除也挺快的啊
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 55个

财富等级: 招财进宝

 楼主| 发表于 2019-2-2 08:12:18 | 显示全部楼层

改的更简洁啦,谢谢啦,我就是半路出家,四处拼凑,只能以达到目的为追求
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 4365个

财富等级: 富可敌国

发表于 2019-2-2 10:08:03 | 显示全部楼层
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复

使用道具 举报

已领礼包: 5295个

财富等级: 富甲天下

发表于 2019-2-2 12:11:05 | 显示全部楼层
不断改进、不断完善,达到一个更高的水平!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 2107个

财富等级: 金玉满堂

发表于 2019-2-2 12:27:09 | 显示全部楼层
谢谢分享、、、、、、、、、、、、、、、、、
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 6434个

财富等级: 富甲天下

发表于 2019-2-2 14:38:41 | 显示全部楼层
学习学习下
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 148个

财富等级: 日进斗金

发表于 2019-2-3 00:20:59 | 显示全部楼层
谢谢共享111111
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-3-29 02:31 , Processed in 0.199223 second(s), 57 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

快速回复 返回顶部 返回列表