社区 › AutoLISP/Visual LISP 编程技术 › 图层控制---------减少图层

自贡黄明儒 发表于 2012-8-13 10:58:16

图层控制---------减少图层

本帖最后由 自贡黄明儒 于 2012-8-21 12:25 编辑

;;减少图层时,力求不影响打印效果
;;用户只有一个选择[根据颜色/根据线型/根据线宽],因而操作容易
;;在明经泡了这么久,一直没有找到这样的工具.通过不断打坐和冥想,现在基本上写成现在的这个样子
;;有时,从设计院来的图,经过几个专业之后,图层有几百个之多,对于后来的处理实在麻烦,我一直想有减少图层的工具,在我的日志上贴出了一个不太成熟的东西
;;本程序是根据highflybird的改变块的颜色改编而来,在此对highflybird表示鸣谢!!!
;;对于颜色我是按索引号处理,虽然我不是色盲,对于颜色转换也不知怎么处理,尽管highflybird和C版都发表有相关程序
;;图中有尺寸时,Defpoints是删不掉的.
;;图层的删除我是用下面(HH:purge)命令删除的.有些软件生成的层(比如<钢构>),尽管图中没有它生成的任何对象,也删不掉图层,不知他们是怎么搞的

(defun HH:purge ()
    (vl-Catch-All-Apply
      '(lambda ()
(vla-Remove
    (vla-GetExtensionDictionary
      (vla-Get-Layers
      (vla-Get-ActiveDocument (vlax-Get-Acad-Object))
      )
    )
    "ACAD_LAYERFILTERS"
)
       )
    )
    (repeat 3
      (vla-purgeall
(vla-get-activedocument (vlax-get-acad-object))
      )
    )
)
;;下面的命令(DeleteLayer LayerName)删除图层好象也不太好使,不知哪位有没有更好的办法?
;;删除图层
(defun DeleteLayer (LayerName / AcadDocument LayerSel LayerObj)
    (setq AcadDocument (vla-get-activedocument (vlax-get-acad-object)))
    (setq LayerSel (vla-get-layers AcadDocument))
    (setq LayerObj (vl-catch-all-apply 'vla-item (list LayerSel LayerName)))
    (cond
      ((vl-catch-all-error-p LayerObj)
       (princ
(strcat "\nError occurs when deleting Layer " LayerName "!")
       )
      )
      ((= (vla-get-name (vla-get-activelayer AcadDocument))
   LayerName
       )
       (princ (strcat "\nLayer " LayerName " is current layer!"))
      )
      (t (vla-delete LayerObj))
    )
)

自贡黄明儒 发表于 2012-8-16 09:13:47

;;;***********图层控制小工具 黄明儒 2012.8.15 命令:TC
;;ET把图层控制放在了首位,可见其重要性
;;本程序主要根据higflybird改变块而改写,同时参阅了C版、gu_xl等程序,在此不一一例举,并对他们表示感谢!!!
;;本程序根据我自己的需要而写,简洁的界面是我的习惯
;;在higflybird的符号管理器中,其实也包括了图层合并

自贡黄明儒 发表于 2012-8-16 09:14:26

本帖最后由 自贡黄明儒 于 2012-8-21 12:28 编辑

整合一下.部分代码

;;1.1解锁所有图层
(defun UnLock_All_Layers ()
    (vlax-for n (vla-get-layers
    (vla-get-ActiveDocument (vlax-get-acad-object))
)
      (vla-put-lock n :vlax-false)
    )
)
;;1.2锁所有图层
(defun Lock_All_Layers ()
    (vlax-for n (vla-get-layers
    (vla-get-ActiveDocument (vlax-get-acad-object))
)
      (vla-put-lock n :vlax-true)
    )
)
;;2.1 解冻所有图层
(defun UnFreeze_All_Layers ()
    (vlax-for n (vla-get-layers
    (vla-get-ActiveDocument (vlax-get-acad-object))
)
      (if (/= (vla-get-name n) (getvar "clayer"))
;;也可以用 (not (equal (vla-get-activelayer adoc) item))判断
(vla-put-Freeze n :vlax-false)
      )
    )
)
;;2.2 冻结所有图层
(defun Freeze_All_Layers ()
    (vlax-for n (vla-get-layers
    (vla-get-ActiveDocument (vlax-get-acad-object))
)
      (if (/= (vla-get-name n) (getvar "clayer"))
;;也可以用 (not (equal (vla-get-activelayer adoc) item))判断
(vla-put-Freeze n :vlax-true)
      )
    )
)
;;3.1 开 所有图层
(defun On_All_Layers ()
    (vlax-for n (vla-get-layers
    (vla-get-ActiveDocument (vlax-get-acad-object))
)
      (vla-put-layeron n :vlax-true)
    )
)
;;3.2 关 所有图层
(defun Off_All_Layers ()
    (vlax-for n (vla-get-layers
    (vla-get-ActiveDocument (vlax-get-acad-object))
)
      (vla-put-layeron n :vlax-false)
    )
)
;;4.1 解冻 解锁 开 所有图层
(defun UnLock_On_UnFreeze_All ()
    (vlax-for n (vla-get-layers
    (vla-get-ActiveDocument (vlax-get-acad-object))
)
      (vla-put-lock n :vlax-false)
      (if (/= (vla-get-name n) (getvar "clayer"))
;;也可以用 (not (equal (vla-get-activelayer adoc) item))判断
(vla-put-Freeze n :vlax-false)
      )
      (vla-put-layeron n :vlax-true)
    )
    (vl-cmdf "regen")
)
;;4.2 冻结 锁定 关所有图层
(defun Lock_Off_Freeze_All ()
    (vlax-for n (vla-get-layers
    (vla-get-ActiveDocument (vlax-get-acad-object))
)
      (vla-put-lock n :vlax-true)
      (if (/= (vla-get-name n) (getvar "clayer"))
;;也可以用 (not (equal (vla-get-activelayer adoc) item))判断
(vla-put-Freeze n :vlax-true)
      )
      (vla-put-layeron n :vlax-false)
    )
)
;;5.1 解冻 解锁 开指定图层
(defun UnLock_UnFreeze_On (strLayer / N)
    (setq n (vla-item (vla-get-layers
   (vla-get-activedocument
   (vlax-get-acad-object)
   )
      )
      strLayer
   )
    )
    (vla-put-lock n :vlax-false)
    (if (/= (vla-get-name n) (getvar "clayer"))
      ;;也可以用 (not (equal (vla-get-activelayer adoc) item))判断
      (vla-put-Freeze n :vlax-false)
    )
    (vla-put-layeron n :vlax-true)
)
;;5.2 冻结 锁定 关指定图层
(defun Lock_Freeze_Off (strLayer / N)
    (setq n (vla-item (vla-get-layers
   (vla-get-activedocument
   (vlax-get-acad-object)
   )
      )
      strLayer
   )
    )
    (vla-put-lock n :vlax-true)
    (if (/= (vla-get-name n) (getvar "clayer"))
      ;;也可以用 (not (equal (vla-get-activelayer adoc) item))判断
      (vla-put-Freeze n :vlax-true)
    )
    (vla-put-layeron n :vlax-false)
)
;;6.1 开实体所在图层
(defun UnLock_UnFreeze_On_Objects (ss / N STRLAYER)
    (Lock_Off_Freeze_All)
    (repeat (setq n (sslength ss))
      (setq
strLayer (cdr (assoc 8 (entget (ssname ss (setq n (1- n))))))
      )
      (UnLock_UnFreeze_On strLayer)
    )
    (princ)
)
;;6.2 关实体所在图层
(defun Lock_Freeze_Off_Objects (ss / N STRLAYER)
    (UnLock_On_UnFreeze_All)
    (repeat (setq n (sslength ss))
      (setq
strLayer (cdr (assoc 8 (entget (ssname ss (setq n (1- n))))))
      )
      (Lock_Freeze_Off strLayer)
    )
    (princ)
)

669423907 发表于 2012-8-16 12:09:19

Defpoints层 可以通过 CAD 的图层合并删除

linshiyin2 发表于 2012-8-16 15:03:58

自带的清理可以自动删除无效图层，这个比较安全

smartstar 发表于 2012-8-16 15:32:04

我来凑个热闹学习学习。

yaokui25 发表于 2012-8-16 21:06:15

学习学习,借鉴借鉴

tianyi1230 发表于 2012-8-16 22:58:40

源码就好了，不过还是感谢

自贡黄明儒 发表于 2012-8-17 09:11:19

tianyi1230 发表于 2012-8-16 22:58 static/image/common/back.gif
源码就好了，不过还是感谢

如果需求的人多，源码放在100层

work0909_a77abc 发表于 2012-10-10 01:21:42

感谢楼主共享，摇鼠标同仁敬上！

查看完整版本: 图层控制---------减少图层