Leaderboard

Typo rlenght on line 4 princ() should be (princ)

You're welcome to use my implementation from here.

@robierzo Rather than accepting bit codes other than closed, it may be wiser to reject the closed bit code, as this will continue to function if additional bit codes are added in future. (ssget "_X" '( (-4 . "<OR") (0 . "ARC,LINE") (-4 . "<AND") (0 . "LWPOLYLINE") (-4 . "<NOT") (-4 . "&=") (70 . 1) (-4 . "NOT>") (-4 . "AND>") (-4 . "OR>") ) )

Not sure if I posted this a while back, but its a fun one all the same (defun c:hl ( / *error* gr pt ent lay ObjSS OldCM NulSS ) (vl-load-com) ;; Lee Mac ~ 08.01.10 (defun *error* ( msg ) (setvar "CMDECHO" OldCM) (mapcar (function redrawSS) (list ObjSS NulSS) '(4 1)) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **"))) (princ) ) (setq OldCM (getvar "CMDECHO")) (setvar "CMDECHO" 0) (princ "\nMove Cursor Over Objects, Click to Isolate Layer...") (while (and (= 5 (car (setq gr (grread 't 13 2)))) (listp (setq pt (cadr gr)))) (if (setq ent (CatchApply ssname (list (ssget pt) 0))) (setq lay (cdr (assoc 8 (entget ent))) ObjSS (redrawSS (ssget "_X" (list (cons 8 lay))) 3) NulSS (redrawSS (ssget "_X" (list (cons -4 "<NOT") (cons 8 lay) (cons -4 "NOT>"))) 2)) (progn (mapcar (function redrawSS) (list ObjSS NulSS) '(4 1)) (setq ObjSS nil NulSS nil) ) ) ) (mapcar (function redrawSS) (list ObjSS NulSS) '(4 1)) (if (and (vl-consp pt) (setq ent (CatchApply ssname (list (ssget pt) 0)))) (vl-cmdf "_.layiso" ent "") ) (setvar "CMDECHO" OldCM) (princ) ) (defun CatchApply ( foo args / result ) (if (not (vl-catch-all-error-p (setq result (vl-catch-all-apply (function foo) args) ) ) ) result ) ) (defun redrawSS ( ss code ) (if ss ( (lambda ( i / e ) (while (setq e (ssname ss (setq i (1+ i)))) (redraw e code) ) ss ) -1 ) ) ) With Multiple Layer Selection: (defun c:hl ( / *error* gr code pt ent l lays ObjSS OldCM NulSS ) (vl-load-com) ;; Lee Mac ~ 08.01.10 (defun *error* ( msg ) (setvar "CMDECHO" OldCM) (mapcar (function redrawSS) (list ObjSS NulSS) '(4 1)) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **"))) (princ) ) (setq OldCM (getvar "CMDECHO")) (setvar "CMDECHO" 0) (princ "\nMove Cursor Over Objects, Click to Isolate Layer...") (while (progn (setq gr (grread 't 13 2) code (car gr) pt (cadr gr)) (cond ( (and (= 5 code) (listp pt)) (if (setq ent (CatchApply ssname (list (ssget pt) 0))) (setq l (cdr (assoc 8 (entget ent))) ObjSS (redrawSS (ssget "_X" (list (cons 8 l))) 3) NulSS (redrawSS (ssget "_X" (list (cons -4 "<NOT") (cons 8 (lst->str (cons l lays) ",")) (cons -4 "NOT>"))) 2)) (progn (mapcar (function redrawSS) (list ObjSS NulSS) '(4 1)) (setq ObjSS nil NulSS nil) ) ) t ) ( (and (= 3 code) (listp pt)) (if (and (setq ent (CatchApply ssname (list (ssget pt) 0))) (not (vl-position (setq l (cdr (assoc 8 (entget ent)))) lays))) (setq lays (cons l lays)) (if (setq ss (GetSelectionSet "\nSpecify Opposite Corner: " pt (if lays (list (cons -4 "<NOT") (cons 8 (lst->str lays ",")) (cons -4 "NOT>")) ) ) ) ( (lambda ( i ) (while (setq e (ssname ss (setq i (1+ i)))) (if (not (vl-position (setq l (cdr (assoc 8 (entget e)))) lays)) (setq lays (cons l lays)) ) ) ) -1 ) ) ) t ) ) ) ) (mapcar (function redrawSS) (list ObjSS NulSS) '(4 1)) (if (and lays (setq ss (ssget "_X" (list (cons 8 (lst->str lays ",")))))) (vl-cmdf "_.layiso" ss "") ) (setvar "CMDECHO" OldCM) (princ) ) (defun CatchApply ( foo args / result ) (if (not (vl-catch-all-error-p (setq result (vl-catch-all-apply (function foo) args) ) ) ) result ) ) (defun redrawSS ( ss code ) (if ss ( (lambda ( i / e ) (while (setq e (ssname ss (setq i (1+ i)))) (redraw e code) ) ss ) -1 ) ) ) (defun GetSelectionSet ( str pt filter / gr data pt1 pt2 lst ) (princ str) (while (and (= 5 (car (setq gr (grread t 13 0)))) (listp (setq data (cadr gr)))) (redraw) (setq pt1 (list (car data) (cadr pt) (caddr data)) pt2 (list (car pt) (cadr data) (caddr data))) (grvecs (setq lst (list (if (minusp (- (car data) (car pt))) -30 30) pt pt1 pt pt2 pt1 data pt2 data ) ) ) ) (redraw) (ssget (if (minusp (car lst)) "_C" "_W") pt data filter) ) (defun lst->str ( lst del ) (if (cdr lst) (strcat (car lst) del (lst->str (cdr lst) del)) (car lst) ) )