图层控制-源码，VL函数，非command，非修改组码 - AutoLISP/Visual LISP 编程技术 - AutoCAD论坛 - 明经CAD社区 - 第6页

革天明 发表于 2013-1-5 08:41:58

楼主的帖子又被顶上来了

linshiyin2 发表于 2013-3-5 09:49:39

;自定义命令
(defun c:vg () (tcgb));图层关闭
(defun c:vk () (tcqbxs));全部显示
(defun c:vgf () (tcgbf));关闭(反)
(defun c:vd () (tcdj));图层冻结
(defun c:vjd () (tcqbjd));全部解冻
(defun c:vdf () (tcdjf));冻结(反)
(defun c:vs () (tcsd));图层锁定
(defun c:vjs () (tcqbjs));全部解锁
(defun c:vsf () (tcsdf));锁定(反)
(defun c:333 () (tcqbxjj));三个全部
;主程序
(vl-load-com)
(defun c:tc (/ DCLID FN FNAME LIN RE)
   (setq fname (vl-filename-mktemp nil nil ".dcl" ))
   (setq fn (open fname "w" ))
   (foreach x '(
                  "agtckz : dialog{"
                  "label=\"图层控制V2.0+ by阿甘\";"
                  " :column{"
                  "    :button{key=\"1\";label=\"图层关闭 <vg>\";width=4;}"
                  "    :button{key=\"2\";label=\"图层冻结 <vd>\";width=4;}"
                  "    :button{key=\"3\";label=\"图层锁定 <vs>\";width=4;}"
                  "    :button{key=\"4\";label=\"关闭(反) <vgf>\";width=4;}"
                  "    :button{key=\"5\";label=\"冻结(反) <vdf>\";width=4;}"
                  "    :button{key=\"6\";label=\"锁定(反) <vsf>\";width=4;}"
                  "    :button{key=\"7\";label=\"全部显示 <vk>\";width=4;}"
                  "    :button{key=\"8\";label=\"全部解冻 <vjd>\";width=4;}"
                  "    :button{key=\"9\";label=\"全部解锁 <vjs>\";width=4;}"
                  "    :button{key=\"10\";label=\"三个全部 <333>\";width=4;}"
                  " }"
                  " ok_cancel;"
                  "}"
         );end ;endlist
         (princ x fn)
         (write-line "" fn)
   );end foreach
   (close fn)
   (setq fn (open fname "r" ))
   (setq dclid (load_dialog fname))
   (while (or (eq (substr (setq lin (vl-string-right-trim "\" fn)" (vl-string-left-trim "(write-line \"" (read-line fn)))) 1 2) "//" ) (eq (substr lin 1 (vl-string-search " " lin)) "" ) (not (eq (substr lin (+ (vl-string-search " " lin) 1) 9) " : dialog" ))))
   (new_dialog (substr lin 1 (vl-string-search " " lin)) dclid)
   (action_tile "1" "(done_dialog 1)" )
   (action_tile "2" "(done_dialog 2)" )
   (action_tile "3" "(done_dialog 3)" )
   (action_tile "4" "(done_dialog 4)" )
   (action_tile "5" "(done_dialog 5)" )
   (action_tile "6" "(done_dialog 6)" )
   (action_tile "7" "(done_dialog 7)" )
   (action_tile "8" "(done_dialog 8)" )
   (action_tile "9" "(done_dialog 9)" )
   (action_tile "10" "(done_dialog 10)" )
   (action_tile "cancel" "(done_dialog 0)" )
   (setq re (start_dialog))
   (cond
         ((= re 1) (tcgb))
         ((= re 2) (tcdj))
         ((= re 3) (tcsd))
         ((= re 4) (tcgbf))
         ((= re 5) (tcdjf))
         ((= re 6) (tcsdf))
         ((= re 7) (tcqbxs))
         ((= re 8) (tcqbjd))
         ((= re 9) (tcqbjs))
         ((= re 10) (tcqbxjj))
   );end cond
   (unload_dialog dclid)
   (close fn)
   (vl-file-delete fname)
   (princ)
);end defun
;[图层关闭]
(defun tcgb (/ AcadObject AcadDocument LayersObj ss n i ent ob lay vlay)
   (setq AcadObject (vlax-get-acad-object)
         AcadDocument (vla-get-ActiveDocument AcadObject)
            LayersObj (vla-get-layers AcadDocument)
   );end setq
   (princ "\n请选择需要关闭的图层" )
   (if (setq ss (ssget))
         (progn
                  (setq n (sslength ss))
                  (setq i (- n 1))
                  (repeat n
                        (setq ent (ssname ss i)
                              ob (vlax-ename->vla-object ent)
                                 lay (vla-get-layer ob)
                                 vlay (vla-item LayersObj lay)
                        );end setq
                        (vla-put-layeron vlay :vlax-false)
                        (setq i (1- i))
                  );end repeat
                     (princ "\n已关闭选择图层" )
   ));end if
   (princ)
);end defun
;[图层全部显示]
(defun tcqbxs (/ AcadObject AcadDocument LayersObj vlay)
   (setq AcadObject (vlax-get-acad-object)
         AcadDocument (vla-get-ActiveDocument AcadObject)
            LayersObj (vla-get-layers AcadDocument)
   );end setq
   (vlax-for vlay LayersObj
         (vla-put-layeron vlay :vlax-true)
   );end vlax-for
   ;(vla-regen AcadDocument AcAllViewPorts) 图形较大有时需要重生成才显示可把这句加上
   (princ "\n已打开全部图层" )
   (princ)
);end defun
;[图层关闭(反)]
(defun tcgbf (/ AcadObject AcadDocument LayersObj ss n i ent ob lay vlay)
   (setq AcadObject (vlax-get-acad-object)
         AcadDocument (vla-get-ActiveDocument AcadObject)
            LayersObj (vla-get-layers AcadDocument)
   );end setq
   (princ "\n请选择需要显示的图层" )
   (if (setq ss (ssget))
         (progn
                     (vlax-for vlay LayersObj
                        (vla-put-layeron vlay :vlax-false)
                  );end vlax-for
                  (setq n (sslength ss))
                  (setq i (- n 1))
                  (repeat n
                        (setq ent (ssname ss i)
                              ob (vlax-ename->vla-object ent)
                                 lay (vla-get-layer ob)
                                 vlay (vla-item LayersObj lay)
                        );end setq
                        (vla-put-layeron vlay :vlax-true)
                        (setq i (1- i))
                  );end repeat
                     (princ "\n已关闭除选择图层外的其余图层" )
   ));end if
   (princ)
);end defun
;[图层冻结]
(defun tcdj (/ AcadObject AcadDocument LayersObj Actlay ss n i ent ob lay vlay TorN)
   (setq AcadObject (vlax-get-acad-object)
         AcadDocument (vla-get-ActiveDocument AcadObject)
            LayersObj (vla-get-layers AcadDocument)
            Actlay (vla-get-name (vla-get-activeLayer AcadDocument))
   );end setq
   (princ "\n请选择需要冻结的图层" )
   (if (setq ss (ssget))
         (progn
                  (setq n (sslength ss))
                  (setq i (- n 1))
                  (repeat n
                        (setq ent (ssname ss i)
                              ob (vlax-ename->vla-object ent)
                                 lay (vla-get-layer ob)
                                 vlay (vla-item LayersObj lay)
                        );end setq
                        (if (/= lay Actlay)
                                 (vla-put-freeze vlay :vlax-true)
                                 (setq TorN T)
                        );end if
                        (setq i (1- i))
                  );end repeat
                     (if TorN
                        (princ "\n除当前层无法冻结外!已冻结其余选择图层" )
                        (princ "\n已冻结选择图层" )
                     );end if
   ));end if
   (princ)
);end defun
;[图层全部解冻]
(defun tcqbjd (/ AcadObject AcadDocument LayersObj Actlay ss n i ent ob lay vlay TorN)
   (setq AcadObject (vlax-get-acad-object)
         AcadDocument (vla-get-ActiveDocument AcadObject)
            LayersObj (vla-get-layers AcadDocument)
            Actlay (vla-get-name (vla-get-activeLayer AcadDocument))
   );end setq
   (vlax-for vlay LayersObj
            (if (/= (vla-get-name vlay) Actlay)
                  (vla-put-freeze vlay :vlax-false)
            );end if
   );end vlax-for
   (vla-regen AcadDocument AcAllViewPorts)
   (princ "\n已解冻全部图层" )
   (princ)
);end defun
;[图层冻结(反)]
(defun tcdjf (/ AcadObject AcadDocument LayersObj Actlay ss n i ent ob lay vlay TorN)
   (setq AcadObject (vlax-get-acad-object)
         AcadDocument (vla-get-ActiveDocument AcadObject)
            LayersObj (vla-get-layers AcadDocument)
            Actlay (vla-get-name (vla-get-activeLayer AcadDocument))
   );end setq
   (princ "\n请选择不需要冻结的图层" )
   (if (setq ss (ssget))
         (progn
                     (vlax-for vlay LayersObj
                           (if (/= (vla-get-name vlay) Actlay)
                                 (vla-put-freeze vlay :vlax-true)
                           );end if
                     );end vlax-for
                  (setq n (sslength ss))
                  (setq i (- n 1))
                  (repeat n
                        (setq ent (ssname ss i)
                              ob (vlax-ename->vla-object ent)
                                 lay (vla-get-layer ob)
                                 vlay (vla-item LayersObj lay)
                        );end setq
                        (if (/= lay Actlay)
                                 (vla-put-freeze vlay :vlax-false)
                                 (setq TorN T)
                        );end if
                        (setq i (1- i))
                  );end repeat
                     (if TorN
                        (princ "\n已冻结除选择图层外的其余图层" )
                        (princ "\n除当前层无法冻结外! 已冻结其余除选择图层外的图层" )
                     );end if
   ));end if
   (princ)
);end defun
;[图层锁定]
(defun tcsd (/ AcadObject AcadDocument LayersObj ss n i ent ob lay vlay)
   (setq AcadObject (vlax-get-acad-object)
         AcadDocument (vla-get-ActiveDocument AcadObject)
            LayersObj (vla-get-layers AcadDocument)
   );end setq
   (princ "\n请选择需要锁定的图层" )
   (if (setq ss (ssget))
         (progn
                  (setq n (sslength ss))
                  (setq i (- n 1))
                  (repeat n
                        (setq ent (ssname ss i)
                              ob (vlax-ename->vla-object ent)
                                 lay (vla-get-layer ob)
                                 vlay (vla-item LayersObj lay)
                        );end setq
                        (vla-put-lock vlay :vlax-true)
                        (setq i (1- i))
                  );end repeat
                     (princ "\n已锁定选择图层" )
   ));end if
   (princ)
);end defun
;[图层全部解锁]
(defun tcqbjs (/ AcadObject AcadDocument LayersObj vlay)
   (setq AcadObject (vlax-get-acad-object)
         AcadDocument (vla-get-ActiveDocument AcadObject)
            LayersObj (vla-get-layers AcadDocument)
   );end setq
   (vlax-for vlay LayersObj
         (vla-put-lock vlay :vlax-false)
   );end vlax-for
   (princ "\n已解锁全部图层" )
   (princ)
);end defun
;[图层解锁(反)]
(defun tcsdf (/ AcadObject AcadDocument LayersObj ss n i ent ob lay vlay)
   (setq AcadObject (vlax-get-acad-object)
         AcadDocument (vla-get-ActiveDocument AcadObject)
            LayersObj (vla-get-layers AcadDocument)
   );end setq
   (princ "\n请选择不需要锁定的图层" )
   (if (setq ss (ssget))
         (progn
                     (vlax-for vlay LayersObj
                        (vla-put-lock vlay :vlax-true)
                  );end vlax-for
                  (setq n (sslength ss))
                  (setq i (- n 1))
                  (repeat n
                        (setq ent (ssname ss i)
                              ob (vlax-ename->vla-object ent)
                                 lay (vla-get-layer ob)
                                 vlay (vla-item LayersObj lay)
                        );end setq
                        (vla-put-lock vlay :vlax-false)
                        (setq i (1- i))
                  );end repeat
                     (princ "\n已锁定除选择图层外的其余图层" )
   ));end if
   (princ)
);end defun
;图层全部显示+解锁+解冻
(defun tcqbxjj (/ ACADDOCUMENT ACADOBJECT ACTLAY LAYERSOBJ)
   (setq AcadObject (vlax-get-acad-object)
         AcadDocument (vla-get-ActiveDocument AcadObject)
            LayersObj (vla-get-layers AcadDocument)
            Actlay (vla-get-name (vla-get-activeLayer AcadDocument))
   );end setq
   (vlax-for vlay LayersObj
            (if (/= (vla-get-name vlay) Actlay)
                  (vla-put-freeze vlay :vlax-false)
            );end if
         (vla-put-layeron vlay :vlax-true)
         (vla-put-lock vlay :vlax-false)
   );end vlax-for
   (vla-regen AcadDocument AcAllViewPorts)
   (princ "\n所有图层已显示+解锁+解冻" )
   (princ)
);end defun
略加修改的版本，定义了局部变量，按钮处显示快捷键。

jsnghost 发表于 2013-3-7 13:28:03

看到这个源码真是学习了呀。太感谢啦

dhtfm 发表于 2013-12-12 18:33:47

楼主很强大，图层管理很好用。谢谢。只是隐藏物体（反）没有反应，不知道是什么原因。

hhh454 发表于 2013-12-16 23:23:46

linshiyin2 发表于 2013-3-5 09:49 static/image/common/back.gif
略加修改的版本，定义了局部变量，按钮处显示快捷键。

功能多了一点，有凸显就好了

print1985 发表于 2014-8-11 22:47:36

界面小更新没技术含量需要的可以拿去玩玩

用户3766035971 发表于 2015-1-22 10:39:54

好。支持源码.

dbqtju 发表于 2015-1-22 12:54:23

支持源代码.

wangxf888 发表于 2015-1-26 13:14:54

收藏备用挺方便的

冒个烟圈 发表于 2015-6-14 19:33:35

顶了再欣赏哈。。。。。

页: 1 2 3 4 5 [6] 7 8 9 10

明经CAD社区's Archiver