模拟ET工具中的layiso！

hanyu_gis

模拟ET工具中的layiso，初学者，程序应该可以做优化，请高手指点：

(defun c:layiso()

          (setvar "cmdecho" 0)

              (princ "\n.....选择所要保留图层上实体......")

       (setq sl (ssget))

       (setq index 0)

       (setq sll (sslength sl))

       (tblnext "layer" T)

       (setq zerolayerentname (tblobjname "layer" "0"))

       (setq  zerotable (entget zerolayerentname))

       (if (> (cdr (assoc '62 zerotable)) 0)

                            (progn     (setq zeroonoff (- 0 (cdr (assoc '62 zerotable))))

                                          (entmod (subst (cons 62 zeroonoff) (assoc '62 zerotable) zerotable))                            

 

                            )

       )

       (while  (setq entable (tblnext "layer"))

                     (setq layerentname (tblobjname "layer" (cdr (assoc '2 entable))))

                     (setq  ennewtable (entget layerentname))

                     (if (> (cdr (assoc '62 ennewtable)) 0)

                            (progn     (setq layeronoff (- 0 (cdr (assoc '62 ennewtable))))

                                          (entmod (subst (cons 62 layeronoff) (assoc '62 ennewtable) ennewtable))

                                         

 

                            )

                     )

              )

       (repeat sll

                     (setq entname (ssname sl index))

            (setq entable (entget entname))

            (setq layername (tblobjname "layer" (cdr (assoc '8 entable))))

            (setq ennewtable (entget layername))

            (if (< (cdr (assoc '62 ennewtable)) 0)

                (progn     (setq layeronoff (- (cdr (assoc '62 ennewtable)) (* 2 (cdr (assoc '62 ennewtable)))))

                                          (setq layertable (subst (cons 62 layeronoff) (assoc '62 ennewtable) ennewtable))

                                          (entmod layertable)

                            )

                     )

           

           (setq index (+ 1 index))

         )

        (princ "\n操作已完成，保留了你所需的图层！")

       (princ)

)

Dallas_whu

给你一个我自己写的吧，应该可以的

;;;将选定对象所在图层保留，其它图层关闭
(DEFUN CO (/ &OLDERR&        *$MYERROR$*     *ERROR*      LAY
           ACADDOCUMENT ACADOBJECT     ENAME          INDEX
           LAYER        LAYERLST     LAYERSOBJ    SS
           VL_ENAME
          )
  (VL-LOAD-COM)
  (DEFUN *$MYERROR$* (MSG)
    (SETQ *ERROR* &OLDERR&)
    (PRINC)
    )
  (SETQ &OLDERR& *ERROR*)
  (SETQ *ERROR* *$MYERROR$*)
  (SETQ ACADOBJECT (VLAX-GET-ACAD-OBJECT))
  (SETQ ACADDOCUMENT (VLAX-GET-PROPERTY ACADOBJECT 'ACTIVEDOCUMENT))
  (SETQ LAYERSOBJ  (VLA-GET-LAYERS ACADDOCUMENT))
  (PRINC "\n请选择欲保留的图层上的对象:")
  (SETQ SS (SSGET))
  (SETQ LIST_LAYER NIL)
  (SETQ INDEX -1)
  (WHILE (SETQ ENAME (SSNAME SS (SETQ INDEX (1+ INDEX))))
    (SETQ VL_ENAME (VLAX-ENAME->VLA-OBJECT ENAME))
    (SETQ LAYER (VLA-GET-LAYER VL_ENAME))
    (IF    (NOT (MEMBER LAYER LIST_LAYER))
      (SETQ LIST_LAYER (CONS LAYER LIST_LAYER))
    )
  )
  (VLAX-FOR LAY LAYERSOBJ
    (VLA-PUT-LAYERON LAY :VLAX-FALSE)
    )
  (FOREACH LAYER LIST_LAYER
    (VLA-PUT-LAYERON (VLA-ITEM LAYERSOBJ LAYER) :VLAX-TRUE)
  )
  (SETQ *ERROR* &OLDERR&)
  (PRINC)
  )

honxj

我们公司用的就是这个，还是很好用的。