Required Layer Switching LISP

[rlx]

;;; switch layer Rlx 11-oct-2022
(defun c:swl ( / _laylist lay-list pos max-pos done inp)
  (vl-load-com)
  ;;; (setq l (_laylist))
  (defun _laylist ( / d r)
    (while (setq d (tblnext "layer" (null d)))(setq r (cons (cdr (assoc 2 d)) r))) (reverse r))
  (setq lay-list (_laylist) pos (vl-position (getvar "clayer") lay-list) max-pos (1- (length lay-list)))
  ;;; make list with layer filters
  (setq lwf (_grouplayerfilterswlayernames))
  
  (princ "\nSwitch layer (Lmouse or - = prev , Rmouse or + = next , f = filter , anyother key = exit)")
  (princ (strcat "\nCurrent layer is " (getvar "clayer")))
  (setq done nil)
  (while (not done)
    (setq inp (vl-catch-all-apply 'grread (list nil 4 1)))
    (if (vl-catch-all-error-p inp)
      (setq done t )
      (cond
        ;;; - or lmouse
        ((or (equal inp '(2 45)) (= (car inp) 3))
         (if (> pos 0)
           (progn (setq pos (1- pos)) (setvar "clayer" (nth pos lay-list))
             (princ (strcat "\rCurrent layer : " (getvar "clayer") " ... ")))
           (princ (strcat "\rYou've reached the first layer ( "(getvar "clayer") " ) "))
         )
        )
        ;;; + or rmouse
        ((or (equal inp '(2 43)) (= (car inp) 25))
         (if (< pos max-pos)
           (progn (setq pos (1+ pos)) (setvar "clayer" (nth pos lay-list))
             (princ (strcat "\rCurrent layer : " (getvar "clayer") " ... ")))
           (princ (strcat "\rYou've reached the last layer ( "(getvar "clayer") " ) "))
         )
        )
        ;;; F or f
        ((or (equal inp '(2 70)) (equal inp '(2 102))) (use_layer_filter))
        (t (setq done t))
      )
    )
  )
  (princ)
)

(defun use_layer_filter ( / lwf inp)
  (cond
    ((not (vl-consp (setq lwf (_grouplayerfilterswlayernames))))
     (alert "This drawing has no layergroups"))
    ((not (setq inp (cfl (cons "All" (mapcar 'car lwf)))))
     (princ "\nLayer group selection cancelled"))
    (t
     (if (not (eq inp "All"))
       (setq lay-list (cadr (assoc inp lwf))) (setq lay-list (_laylist)))
    )
  )
  ;;; filtered list will have different length then total list so reset pos & pos-max
  (setq max-pos (1- (length lay-list)))
  (if (member (getvar "clayer") lay-list)
    (setq pos (vl-position (getvar "clayer") lay-list)) (setq pos 0))
  (setvar "clayer" (nth pos lay-list))
  (princ (strcat "\rCurrent layer : " (getvar "clayer") " ... "))
)

; choose from list (cfl '("1""2""3"))
(defun cfl (l / f p d r) (and (setq p (open (setq f (vl-filename-mktemp ".dcl")) "w"))
  (princ "cfl:dialog{label=\"Choose\";:list_box{key=\"lb\";}ok_cancel;}" p)(not (setq p (close p)))
    (< 0 (setq d (load_dialog f)))(new_dialog "cfl" d)(progn (start_list "lb")(mapcar 'add_list l)
      (end_list) (action_tile "lb" "(setq r (nth (atoi $value) l))(done_dialog 1)")(action_tile "accept"
        "(setq r (get_tile \"lb\"))(done_dialog 1)")(action_tile "cancel" "(setq r nil)(done_dialog 0)")
           (start_dialog)(unload_dialog d)(vl-file-delete f)))(cond ((= r "") nil)(r r)(t nil)))

;;; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/retrieve-layer-names-from-group-layer-filter/td-p/8805768
;;; Lee Mac / RJP » 2019-05-21 added list of layer names associated with filter
(defun _grouplayerfilterswlayernames nil
  ((lambda (foo)(foo (entget (cdr (assoc 330 (entget (tblobjname "layer" "0")))))))
    (lambda (enx / dic i itm rtn) (and (setq dic (cdr (assoc 360 (member '(102 . "{ACAD_XDICTIONARY") enx))))
      (setq dic (cdr (assoc -1 (dictsearch dic "aclydictionary")))) (while (setq itm (dictnext dic (not itm)))
	(if (= "AcLyLayerGroup" (cdr (assoc 1 itm))) (setq i (assoc 300 itm) rtn (cons (list (cdr i)(mapcar '(lambda (y)
          (cdr (assoc 2 (entget (cdr y)))))(vl-remove-if '(lambda (x)(/= 330 (car x)))(member i itm)))) rtn)))))(reverse rtn))))

 

You now have letter f (or F) for filter (thanx Lee/Ron for example code I found with google)

 

Edited October 11, 2022 by rlx

[mhupp]

Nice to see my fav dragon kicking around.

[rlx]

12 minutes ago, mhupp said:

Nice to see my fav dragon kicking around.

 

Thank you mhupp , don't have so much time to code anymore but just wanted to see if my last remaining functional braincell was still working you know