【分享】新做了一个图层锁定变灰的程序

happysheep · 发表于 2014-3-6 21:03:29

本帖最后由 happysheep 于 2014-3-14 16:31 编辑

在论坛上从诸位前辈的代码中学到了很多东西，谢谢大家！

程序使用LAY启动，功能如下：

单选反锁(S)<默认>：选择一个对象，除此对象所在层以外的所有层，锁定并变成灰色；
锁定指定层(L)：选择一个或多个对象，其所在的层锁定并变成灰色。如果对象是外部引用或块，其内部的层也如此处理。此命令对嵌套的外部引用或块同样有效。
单独解锁一层(U)：选择一个或多个对象，其所在的层解锁并恢复原色。如果对象是外部引用或块，其内部的层也如此处理。此命令对嵌套的外部引用或块同样有效。
全部解锁(UU) ：将图中所有图层解锁并恢复颜色。

程序现在的问题是，
1. 标注中的数字，原本是白色，锁定时被变为随层，解锁时变回来。但程序中用的是命令entupd，运行时间较长，有没有更好的办法？
变为随层：

(if (= (vla-get-ObjectName obj) "AcDbRotatedDimension")
(vla-put-textcolor obj acbylayer)
)

变回白色：

(if (= (vla-get-ObjectName obj) "AcDbRotatedDimension")
(vla-put-textcolor obj acWhite)
)

2. 为了解决标注文字颜色不随层的问题，单独把嵌套的外部引用中的所有对象递归遍历了一遍，造成程序运行时间较长，如何解决？

(defun Dim-Restore-Recursion (obj / SubObj)
(if (= (vla-get-ObjectName obj) "AcDbRotatedDimension")
(vla-put-textcolor obj acWhite)
)
(if (= (vla-get-ObjectName obj) "AcDbBlockReference")
(vlax-for SubObj
(vla-item (vla-get-blocks doc)
(vla-get-name obj) ;获得块名
)
(Dim-Restore-Recursion SubObj)
)
)
)

以下是程序全文：

;;;程序开始
(vl-load-com)
;;;生成图层列表
(defun laytab ()
(setq first T)
(setq layertab '())
(while (setq lay1 (tblnext "layer" first))
(if (= first T)
(setq first nil)
)
(if (/= lay1 nil)
(progn (setq lay2 (cdr (assoc 2 lay1)))
(setq layertab (cons lay2 layertab))
)
)
)
)
;;;用递归实现遍历所有对象，颜色变灰、图层锁定
(defun Change-Lock-Recursion (obj / layname vla_lay SubObj laycolor layhandle)
;;颜色变灰、图层锁定
(setq layname (vlax-get-property obj 'Layer))
(setq vla_lay (vla-item (vla-get-layers doc) layname))
(setq laycolor (vlax-get-property vla_lay 'Color))
(if (/= laycolor 252)
(progn
(setq layhandle (vla-get-handle vla_lay))
(VLAX-LDATA-PUT "data" layhandle laycolor)
(vlax-put-property vla_lay 'Color 252)
(vla-put-lock vla_lay :vlax-true)
) ;如果颜色不是252，则存颜色并改成252
)
;;颜色变灰、图层锁定结束
(if (= (vla-get-ObjectName obj) "AcDbBlockReference")
(vlax-for SubObj
(vla-item (vla-get-blocks doc)
(vla-get-name obj) ;获得块名
) ;获取当前文档中的所有块，按照名字从中找到操作者选择的块，返回块中所有对象的集合
(Change-Lock-Recursion SubObj) ;obj依次为块内每一个图元的对象
) ;调用自己，递归，遍历引用中的每层引用
)
)
(defun Dim-Color-Recursion (obj / SubObj)
;;如果是标注，则把文字颜色改为随层
(if (= (vla-get-ObjectName obj) "AcDbRotatedDimension")
(vla-put-textcolor obj acbylayer)
)
;;;
(if (= (vla-get-ObjectName obj) "AcDbBlockReference")
(vlax-for SubObj
(vla-item (vla-get-blocks doc)
(vla-get-name obj) ;获得块名
) ;获取当前文档中的所有块，按照名字从中找到操作者选择的块，返回块中所有对象的集合
(Dim-Color-Recursion SubObj) ;obj依次为块内每一个图元的对象
) ;调用自己，递归，遍历引用中的每层引用
)
)
;;;选择锁定
(defun lockl (e / obj layname vla_lay laycolor)
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq obj (vlax-ename->vla-object e))
(setq layname (vlax-get-property obj 'Layer))
(setq vla_lay (vla-item (vla-get-layers doc) layname))
(setq laycolor (vlax-get-property vla_lay 'Color))
(if (/= laycolor 252)
(progn
(Dim-Color-Recursion obj)
(Change-Lock-Recursion obj)
(entupd e)
)
) ;不regen的话，标注文字颜色无法刷新
)
;;;用递归实现遍历所有对象，颜色恢复、图层解锁
(defun Restore-Unlock-Recursion (obj / SubObj)
;;颜色恢复、图层解锁
(setq layname (vlax-get-property obj 'Layer))
(setq vla_lay (vla-item (vla-get-layers doc) layname))
(setq layhandle (vla-get-handle vla_lay))
(vla-put-lock vla_lay :vlax-false) ;不管怎样，先解锁
(if (setq laycolor (VLAX-LDATA-get "data" layhandle))
(progn
(vlax-put-property vla_lay 'Color laycolor)
(vlax-ldata-delete "data" layhandle)
)
)
;;颜色恢复、图层解锁结束
(if (= (vla-get-ObjectName obj) "AcDbBlockReference")
(vlax-for SubObj
(vla-item (vla-get-blocks doc)
(vla-get-name obj) ;获得块名
) ;获取当前文档中的所有块，按照名字从中找到操作者选择的块，返回块中所有对象的集合
(Restore-Unlock-Recursion SubObj) ;obj依次为块内每一个图元的对象
) ;调用自己，递归，遍历引用中的每层引用
)
)
(defun Dim-Restore-Recursion (obj / SubObj)
;;如果是标注，则把文字颜色改回白色
(if (= (vla-get-ObjectName obj) "AcDbRotatedDimension")
(vla-put-textcolor obj acWhite)
)
;;;
(if (= (vla-get-ObjectName obj) "AcDbBlockReference")
(vlax-for SubObj
(vla-item (vla-get-blocks doc)
(vla-get-name obj) ;获得块名
) ;获取当前文档中的所有块，按照名字从中找到操作者选择的块，返回块中所有对象的集合
(Dim-Restore-Recursion SubObj) ;obj依次为块内每一个图元的对象
) ;调用自己，递归，遍历引用中的每层引用
)
)
;;;单选解锁
(defun unlock (e / obj)
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq obj (vlax-ename->vla-object e))
(Restore-Unlock-Recursion obj)
(Dim-Restore-Recursion obj)
(entupd e) ;否则标注文字颜色无法刷新
)
;;;单选反锁……选定对象以外的层都锁定改色
(defun locks (e / n m laycolor layname layhandle)
(setq n (length layertab))
(setq m 0)
(setq obj (vlax-ename->vla-object e))
(setq h (vlax-get-property obj 'Layer))
(vla-put-ActiveLayer
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
(vla-item (vla-get-layers doc) h)
) ;置为当前层
(while (/= m n)
(if (/= h (setq layname (nth m layertab)))
(progn
(setq vla_lay (vla-item (vla-get-layers doc) layname))
(setq laycolor (vlax-get-property vla_lay 'Color))
(setq layhandle (vla-get-handle vla_lay))
(VLAX-LDATA-PUT "data" layhandle laycolor)
(vlax-put-property vla_lay 'Color 252)
(vla-put-lock vla_lay :vlax-true)
)
)
(setq m (+ m 1))
)
)
;;;全部解锁
(defun unall (/ n m vla_lay laycolor layname layhandle)
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq n (length layertab))
(setq m 0)
(while (/= m n)
(setq layname (nth m layertab))
(setq vla_lay (vla-item (vla-get-layers doc) layname))
(setq layhandle (vla-get-handle vla_lay))
(vla-put-lock vla_lay :vlax-false) ;先解锁
(if (setq laycolor (VLAX-LDATA-get "data" layhandle))
;如果词典里有该层信息，则改颜色
(progn
(vlax-put-property vla_lay 'Color laycolor)
(vlax-ldata-delete "data" layhandle)
)
)
(setq m (+ m 1))
)
)
;;;选择锁定
(defun ll (/ n m e_ss e)
(setvar "cmdecho" 0)
(command "_.undo" "be")
(prompt "\n选择需要锁定的图层上的对象:")
(if (setq e_ss (ssget))
(progn (setq n (sslength e_ss))
(setq m 0)
(while (/= m n)
(setq e (ssname e_ss m))
(lockl e)
(setq m (+ m 1))
)
)
)
(command "_.undo" "e")
(setvar "cmdecho" 1)
)
;;;选择解锁
(defun ul (/ n m e_ss e)
(setvar "cmdecho" 0)
(command "_.undo" "be")
(prompt "\n选择需要解锁的图层上的对象:")
(if (setq e_ss (ssget))
(progn (setq n (sslength e_ss))
(setq m 0)
(while (/= m n)
(setq e (ssname e_ss m))
(unlock e)
(setq m (1+ m))
)
)
)
(command "_.undo" "e")
(setvar "cmdecho" 1)
)
;;;全部解锁
(defun ull ()
(laytab)
(setvar "cmdecho" 0)
(command "_.undo" "be")
(unall)
(command "_.undo" "e")
(setvar "cmdecho" 1)
)
;;;单选解锁反锁
(defun lul ()
(setvar "cmdecho" 0)
(command "_.undo" "be")
(if (setq e (car (entsel "\n选择需要编辑的图层上的对象:")))
(progn
(laytab)
(unall)
(locks e)
) ;必须要先全部解开，不能只解开选定层，否则无法保存其他层的颜色信息
)
(command "_.undo" "e")
(setvar "cmdecho" 1)
)
;;;;;定义操作
(defun c:lay (/ code layname laycolor layltype laylst)
(initget "S L U UU")
(setq code
(getkword
"\n单选反锁(S)<默认>/锁定指定层(L)/单独解锁一层(U)/全部解锁(UU)"
)
)
(cond ((= code "L") (LL))
((= code "U") (UL))
((= code "UU") (ULL))
((= code "S") (LUL))
((LUL))
)
(princ)
)
;;;程序结束

;;;程序开始 
(vl-load-com) 
 
;;;生成图层列表 
(defun laytab () 
  (setq first T) 
  (setq layertab '()) 
  (while (setq lay1 (tblnext "layer" first)) 
    (if  (= first T) 
      (setq first nil) 
    ) 
    (if  (/= lay1 nil) 
      (progn (setq lay2 (cdr (assoc 2 lay1))) 
       (setq layertab (cons lay2 layertab)) 
      ) 
    ) 
  ) 
) 
 
;;;用递归实现遍历所有对象，颜色变灰、图层锁定 
(defun Change-Lock-Recursion (obj / layname vla_lay SubObj laycolor layhandle) 
  ;;颜色变灰、图层锁定 
  (setq layname (vlax-get-property obj 'Layer)) 
  (setq vla_lay (vla-item (vla-get-layers doc) layname)) 
  (setq laycolor (vlax-get-property vla_lay 'Color)) 
  (if (/= laycolor 252) 
    (progn 
    (setq layhandle (vla-get-handle vla_lay)) 
   (VLAX-LDATA-PUT "data" layhandle laycolor) 
    (vlax-put-property vla_lay 'Color 252) 
    (vla-put-lock vla_lay :vlax-true) 
    )          ;如果颜色不是252，则存颜色并改成252 
  ) 
  ;;颜色变灰、图层锁定结束 
  (if (= (vla-get-ObjectName obj) "AcDbBlockReference") 
    (vlax-for SubObj 
         (vla-item (vla-get-blocks doc) 
             (vla-get-name obj) ;获得块名 
         )      ;获取当前文档中的所有块，按照名字从中找到操作者选择的块，返回块中所有对象的集合 
      (Change-Lock-Recursion SubObj)  ;obj依次为块内每一个图元的对象 
    )          ;调用自己，递归，遍历引用中的每层引用 
  ) 
) 
 
 
(defun Dim-Color-Recursion (obj / SubObj) 
  ;;如果是标注，则把文字颜色改为随层 
  (if (= (vla-get-ObjectName obj) "AcDbRotatedDimension") 
    (vla-put-textcolor obj acbylayer) 
  ) 
;;; 
  (if (= (vla-get-ObjectName obj) "AcDbBlockReference") 
    (vlax-for SubObj 
         (vla-item (vla-get-blocks doc) 
             (vla-get-name obj) ;获得块名 
         )      ;获取当前文档中的所有块，按照名字从中找到操作者选择的块，返回块中所有对象的集合 
      (Dim-Color-Recursion SubObj)  ;obj依次为块内每一个图元的对象 
    )          ;调用自己，递归，遍历引用中的每层引用 
  ) 
) 
 
;;;选择锁定 
(defun lockl (e / obj layname vla_lay laycolor) 
  (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))) 
  (setq obj (vlax-ename->vla-object e)) 
  (setq layname (vlax-get-property obj 'Layer)) 
  (setq vla_lay (vla-item (vla-get-layers doc) layname)) 
  (setq laycolor (vlax-get-property vla_lay 'Color)) 
  (if (/= laycolor 252) 
    (progn 
      (Dim-Color-Recursion obj) 
      (Change-Lock-Recursion obj) 
      (entupd e) 
    ) 
  )          ;不regen的话，标注文字颜色无法刷新 
) 
 
;;;用递归实现遍历所有对象，颜色恢复、图层解锁 
(defun Restore-Unlock-Recursion  (obj / SubObj) 
  ;;颜色恢复、图层解锁 
  (setq layname (vlax-get-property obj 'Layer)) 
  (setq vla_lay (vla-item (vla-get-layers doc) layname)) 
  (setq layhandle (vla-get-handle vla_lay)) 
  (vla-put-lock vla_lay :vlax-false)  ;不管怎样，先解锁 
  (if (setq laycolor (VLAX-LDATA-get "data" layhandle)) 
    (progn 
      (vlax-put-property vla_lay 'Color laycolor) 
      (vlax-ldata-delete "data" layhandle) 
    ) 
  ) 
  ;;颜色恢复、图层解锁结束 
  (if (= (vla-get-ObjectName obj) "AcDbBlockReference") 
    (vlax-for SubObj 
         (vla-item (vla-get-blocks doc) 
             (vla-get-name obj) ;获得块名 
         )      ;获取当前文档中的所有块，按照名字从中找到操作者选择的块，返回块中所有对象的集合 
      (Restore-Unlock-Recursion SubObj)  ;obj依次为块内每一个图元的对象 
    )          ;调用自己，递归，遍历引用中的每层引用 
  ) 
) 
 
(defun Dim-Restore-Recursion (obj / SubObj) 
  ;;如果是标注，则把文字颜色改回白色 
  (if (= (vla-get-ObjectName obj) "AcDbRotatedDimension") 
    (vla-put-textcolor obj acWhite) 
  ) 
;;; 
  (if (= (vla-get-ObjectName obj) "AcDbBlockReference") 
    (vlax-for SubObj 
         (vla-item (vla-get-blocks doc) 
             (vla-get-name obj) ;获得块名 
         )      ;获取当前文档中的所有块，按照名字从中找到操作者选择的块，返回块中所有对象的集合 
      (Dim-Restore-Recursion SubObj)  ;obj依次为块内每一个图元的对象 
    )          ;调用自己，递归，遍历引用中的每层引用 
  ) 
) 
 
;;;单选解锁 
(defun unlock (e / obj) 
  (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))) 
  (setq obj (vlax-ename->vla-object e)) 
  (Restore-Unlock-Recursion obj) 
  (Dim-Restore-Recursion obj) 
  (entupd e)     ;否则标注文字颜色无法刷新 
) 
 
;;;单选反锁……选定对象以外的层都锁定改色 
(defun locks (e / n m laycolor layname layhandle) 
  (setq n (length layertab)) 
  (setq m 0) 
  (setq obj (vlax-ename->vla-object e)) 
  (setq h (vlax-get-property obj 'Layer)) 
  (vla-put-ActiveLayer 
    (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))) 
    (vla-item (vla-get-layers doc) h) 
  )          ;置为当前层 
  (while (/= m n) 
    (if  (/= h (setq layname (nth m layertab))) 
      (progn 
  (setq vla_lay (vla-item (vla-get-layers doc) layname)) 
  (setq laycolor (vlax-get-property vla_lay 'Color)) 
  (setq layhandle (vla-get-handle vla_lay)) 
  (VLAX-LDATA-PUT "data" layhandle laycolor) 
  (vlax-put-property vla_lay 'Color 252) 
  (vla-put-lock vla_lay :vlax-true) 
      ) 
    ) 
    (setq m (+ m 1)) 
  ) 
) 
 
;;;全部解锁 
(defun unall (/ n m vla_lay laycolor layname layhandle) 
  (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))) 
  (setq n (length layertab)) 
  (setq m 0) 
  (while (/= m n) 
    (setq layname (nth m layertab)) 
    (setq vla_lay (vla-item (vla-get-layers doc) layname)) 
    (setq layhandle (vla-get-handle vla_lay)) 
    (vla-put-lock vla_lay :vlax-false)  ;先解锁 
    (if  (setq laycolor (VLAX-LDATA-get "data" layhandle)) 
          ;如果词典里有该层信息，则改颜色 
      (progn 
  (vlax-put-property vla_lay 'Color laycolor) 
  (vlax-ldata-delete "data" layhandle) 
      ) 
    ) 
    (setq m (+ m 1)) 
  ) 
) 
 
;;;选择锁定 
(defun ll (/ n m e_ss e) 
  (setvar "cmdecho" 0) 
  (command "_.undo" "be") 
  (prompt "\n选择需要锁定的图层上的对象:") 
  (if (setq e_ss (ssget)) 
    (progn (setq n (sslength e_ss)) 
     (setq m 0) 
     (while (/= m n) 
       (setq e (ssname e_ss m)) 
       (lockl e) 
       (setq m (+ m 1)) 
     ) 
    ) 
  ) 
  (command "_.undo" "e") 
  (setvar "cmdecho" 1) 
) 
;;;选择解锁 
(defun ul (/ n m e_ss e) 
  (setvar "cmdecho" 0) 
  (command "_.undo" "be") 
  (prompt "\n选择需要解锁的图层上的对象:") 
  (if (setq e_ss (ssget)) 
    (progn (setq n (sslength e_ss)) 
     (setq m 0) 
     (while (/= m n) 
       (setq e (ssname e_ss m)) 
       (unlock e) 
       (setq m (1+ m)) 
     ) 
    ) 
  ) 
  (command "_.undo" "e") 
  (setvar "cmdecho" 1) 
) 
 
;;;全部解锁 
(defun ull () 
  (laytab) 
  (setvar "cmdecho" 0) 
  (command "_.undo" "be") 
  (unall) 
  (command "_.undo" "e") 
  (setvar "cmdecho" 1) 
) 
;;;单选解锁反锁 
(defun lul () 
  (setvar "cmdecho" 0) 
  (command "_.undo" "be") 
  (if (setq e (car (entsel "\n选择需要编辑的图层上的对象:"))) 
    (progn 
      (laytab) 
      (unall) 
      (locks e) 
    )          ;必须要先全部解开，不能只解开选定层，否则无法保存其他层的颜色信息 
  ) 
  (command "_.undo" "e") 
  (setvar "cmdecho" 1) 
) 
;;;;;定义操作 
(defun c:lay (/ code layname laycolor layltype laylst) 
  (initget "S L U UU") 
  (setq  code 
   (getkword 
     "\n单选反锁(S)<默认>/锁定指定层(L)/单独解锁一层(U)/全部解锁(UU)" 
   ) 
  ) 
  (cond  ((= code "L") (LL)) 
  ((= code "U") (UL)) 
  ((= code "UU") (ULL)) 
  ((= code "S") (LUL)) 
  ((LUL)) 
  ) 
  (princ) 
) 
 
;;;程序结束

USER2128 · 发表于 2014-3-7 08:18:42

支持楼主
可在程序中加入“(command "_.regen")”一行

lz123456 · 发表于 2014-3-7 08:54:13

本帖最后由 lz123456 于 2014-3-7 09:04 编辑

单选反锁, 单独解锁一层(U),
这个最好是搞成框选反锁,解锁，点选效率不高

yzr2002626 · 发表于 2014-3-7 09:30:36

楼主有几个问题
1.就那选择锁定指定层后，全部解锁不能恢复颜色，必须每个单独解锁才能恢复颜色
2.那默认的反锁，把图中原来关闭的层自动打开了，

happysheep · 发表于 2014-3-7 09:55:55

yzr2002626 发表于 2014-3-7 09:30
楼主有几个问题
1.就那选择锁定指定层后，全部解锁不能恢复颜色，必须每个单独解锁才能恢复颜色
2.那默认 ...

试了一下，好像不存在你说的问题呀。锁定和解锁功能是正常的，另外程序不涉及开关图层，关闭的图层不会受影响

happysheep · 发表于 2014-3-7 10:02:35

lz123456 发表于 2014-3-7 08:54
单选反锁, 单独解锁一层(U),
这个最好是搞成框选反锁,解锁，点选效率不高

呵呵，这个我是根据我工作需要来的，框选的话，需要多按一次键盘

yzr2002626 · 发表于 2014-3-7 10:06:50

用的是你最初的那程序，现在的没问题。只是解锁的时候最好是能多选。有时候框选锁定要多选几次才行（选择的东西包含块，线，字的时候)

happysheep · 发表于 2014-3-10 17:45:14

yzr2002626 发表于 2014-3-7 10:06
用的是你最初的那程序，现在的没问题。只是解锁的时候最好是能多选。有时候框选锁定要多选几次才行（选择的 ...

修改了1楼的程序全文。
现在解锁的时候也可以多选了。
另外，原来单选反锁之后，再选择锁定，会因为图层已锁不能修改而报错，现在增加了判断语句，不会报错了。

现在，单选反锁的时候，只修改层颜色，由于没有遍历所有对象，不能把颜色为不随层的对象也改成灰色，比如标注中的文字。

llsheng_73 · 发表于 2014-3-10 20:46:54

本帖最后由 llsheng_73 于 2014-3-10 21:22 编辑

图层也可以直接用ENTMOD来修改的
(setq la(entget(tblobjname "layer" "0")))
(entmod(subst(cons 70 (+(cdr(assoc 70 la))4))(assoc 70 la)la))如果图层0本来是锁定的，它会开锁，反之进行锁定
这个比较奇怪，它不需要逆运算

happysheep · 发表于 2014-3-13 15:44:59

llsheng_73 发表于 2014-3-10 20:46
图层也可以直接用ENTMOD来修改的
(setq la(entget(tblobjname "layer" "0")))
(entmod(subst(cons 70 (+( ...

请问，有没有类似的针对层对象的命令，即vla命令
我程序里面都是转成层对象操作的

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

[源码] 【分享】新做了一个图层锁定变灰的程序

评分

本帖被以下淘专辑推荐:

相关帖子