select current layer and freeze all - LISP ROUTINE then when done thaw all

[NIEKO]

I am working with AutoCad2018

Is there a lisp routine available where you can set a layer to become current that will freeze all other layers in one operation

 

eg

you pick a layer to set it to current

then immediatly it will freeze all other layers

 

thanks in advance

 

PS in my previous AutoCad2000 version there was an option - to freeze ALL layers at once

[ronjonp]

LAYISO

Edited April 27, 2022 by ronjonp

[exceed]

; Freezes all layer, except selected objects' - 2022.04.28 exceed
; Command List
; SFR - Freeze all layer, except selected objects'. The current layer is randomly changed among the layers of the selected object.
; LAF - Freeze all layer, except current layer
; LAF1 - Freeze selected object's layer
; LAFU - Thaw(UnFreeze) all layer

(vl-load-com)
(defun c:SFR ( / *doc* *error* ss ssl answer index layerlist layertxt layerlist layerlistlen x )
  (setvar 'cmdecho 0)
  (LM:startundo (LM:acdoc))
    (defun *error* ( msg )
        (setvar 'cmdecho 1)
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (princ)
    )
  (princ "\n Select objects to exclude from freezing = ")
  (setq ss (ssget))
  (setq ssl (sslength ss))
  (if (> ssl 10000)
    (progn 
      (setq answer (getstring "\n It takes a long time with over 10000 selected objects. Do you still want to run it? (Y - Yes / ESC = No / Space bar - Re-Select )"))
        (cond
          ((/= answer ""))
          ((= answer "") (c:SFR)) ; re-select 
        ); end of cond
    ); end of progn
    (progn
    )
  )
  (setq index 0)
  (setq layerlist '())
  (repeat ssl
    (setq layertxt (cdr (assoc 8 (entget (ssname ss index) ) ) ) )
    (setq layerlist (cons layertxt layerlist))
    (setq index (+ index 1))
  )
  (setq layerlist (LM:Unique (vl-sort layerlist '<)))
  (setq layerlistlen (length layerlist))
  (princ "\n Only")
  (princ layerlistlen)
  (princ " layers to which ")
  (princ ssl)
  (princ " objects belong were excluded from freezing.")
  (princ "\n Layer List - ")
  (princ layerlist)
  (setvar "clayer" (car layerlist))
  (setq layerlist (mapcar 'strcase layerlist))

  (vlax-for x (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
       (if (member (strcase (vla-get-name x)) layerlist)
           (vla-put-freeze x :vlax-false)
           (vla-put-freeze x :vlax-true)
       )
   )
  (vla-regen (vla-get-activedocument (vlax-get-acad-object)) acAllViewports)
  (princ "\n SFR Complete. Run LAFU to unfreeze them all")
  (setvar 'cmdecho 1)
  (LM:endundo (LM:acdoc))
  (princ)
)

(defun c:LAF1 (/ ss)
(princ "\n Freezes the layer of the selected object. (The current layer cannot be frozen.)")
  (if (setq ss (ssget))
    (progn
      (command "-layer" "_F" "" ss "" "")
    )
  )
  (princ)
)


(defun c:LAF (/ ss)
(princ "\n freeze the entire layer. except current layer.")
  (command "-layer" "_F" "*" "")
  (princ)
)


(defun c:LAFU (/ ss)
(princ "\n Unfreeze the entire layer. ")
  (command "-layer" "_T" "*" "")
  (princ)
)





;; Active Document  -  Lee Mac
;; Returns the VLA Active Document Object

(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)

;; Start Undo  -  Lee Mac
;; Opens an Undo Group.

(defun LM:startundo ( doc )
    (LM:endundo doc)
    (vla-startundomark doc)
)

;; End Undo  -  Lee Mac
;; Closes an Undo Group.

(defun LM:endundo ( doc )
    (while (= 8 (logand 8 (getvar 'undoctl)))
        (vla-endundomark doc)
    )
)

 

This is a routine that makes the simple path more complicated than necessary.

but I have made it to study.

 

To put this in your Lisp, like this FOO

(defun c:FOO ( / ss )
  (setq ss (ssget))
  (ex:SFR ss)
  
  ; your lisp
  
  (ex:LAFU)
  (princ)
)


(vl-load-com)
(defun ex:SFR ( ss / *doc* *error* ssl answer index layerlist layertxt layerlist layerlistlen x )
  (setvar 'cmdecho 0)
  (LM:startundo (LM:acdoc))
    (defun *error* ( msg )
        (setvar 'cmdecho 1)
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (princ)
    )
  ;(princ "\n Select objects to exclude from freezing = ")

  ;(setq ss (ssget))

  (setq ssl (sslength ss))
  (if (> ssl 10000)
    (progn 
      (setq answer (getstring "\n It takes a long time with over 10000 selected objects. Do you still want to run it? (Y - Yes / ESC = No / Space bar - Re-Select )"))
        (cond
          ((/= answer ""))
          ((= answer "") (c:SFR)) ; re-select 
        ); end of cond
    ); end of progn
    (progn
    )
  )
  (setq index 0)
  (setq layerlist '())
  (repeat ssl
    (setq layertxt (cdr (assoc 8 (entget (ssname ss index) ) ) ) )
    (setq layerlist (cons layertxt layerlist))
    (setq index (+ index 1))
  )
  (setq layerlist (LM:Unique (vl-sort layerlist '<)))
  (setq layerlistlen (length layerlist))
  ;(princ "\n Only")
  ;(princ layerlistlen)
  ;(princ " layers to which ")
  ;(princ ssl)
  ;(princ " objects belong were excluded from freezing.")
  ;(princ "\n Layer List - ")
  ;(princ layerlist)
  (setvar "clayer" (car layerlist))
  (setq layerlist (mapcar 'strcase layerlist))

  (vlax-for x (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
       (if (member (strcase (vla-get-name x)) layerlist)
           (vla-put-freeze x :vlax-false)
           (vla-put-freeze x :vlax-true)
       )
   )
  (vla-regen (vla-get-activedocument (vlax-get-acad-object)) acAllViewports)
  ;(princ "\n SFR Complete. Run LAFU to unfreeze them all")
  (setvar 'cmdecho 1)
  (LM:endundo (LM:acdoc))
  (princ)
)

(defun ex:LAFU (/ ss)
;(princ "\n Unfreeze the entire layer. ")
  (command "-layer" "_T" "*" "")
  (princ)
)





;; Active Document  -  Lee Mac
;; Returns the VLA Active Document Object

(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)

;; Start Undo  -  Lee Mac
;; Opens an Undo Group.

(defun LM:startundo ( doc )
    (LM:endundo doc)
    (vla-startundomark doc)
)

;; End Undo  -  Lee Mac
;; Closes an Undo Group.

(defun LM:endundo ( doc )
    (while (= 8 (logand 8 (getvar 'undoctl)))
        (vla-endundomark doc)
    )
)

 

 

Edited April 28, 2022 by exceed

[Dadgad]

7 hours ago, ronjonp said:

LAYISO

I love the LAYISO command, I use it all the time.  I have set the alias for it to "LI",  and "LU" for LAYUNISO.

For those that still use Toolbars, there are a number of great tools available on the  LAYERS 2  Toolbar, which

crank up one's productivity.  Another one on that toolbar which I really like is    LAYWALK. 

[NIEKO]

THANK YOU GUYS !!!!!!!!!

I REALLY APPRECIATE THIS

GO WELL

 

nieko