Upgraded LayIso

[Lee Mac]

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)
 )
)

[ReMark]

Lee:

 

Nice routine. Now it's time to design that perfect pick-up line for the girls.

[Lee Mac]

Haha cheers Mark

[stevesfr]

Lee:

 

Nice routine. Now it's time to design that perfect pick-up line for the girls.

 

 

He: "Hey baby, wanna see my LISPS, I mean my etchings?"

 

She: "function canceled", 'improper argument'....

[Lee Mac]

Nah, I'm a mathematician...

 

"If I were sin^2 you'd be cos^2, 'cause together we'd be one..."

 

"Do you want to see the exponential growth of my natural log?"

 

:lol:

[alanjt]

I wish I was your derivative so I could lie tangent to your curves.

 

How can I know so many hundreds of digits of pi and not the 7 digits of your phone number?

[tzframpton]

How can I know so many hundreds of digits of pi and not the 7 digits of your phone number?

Holy crap Alan I seriously almost ruined my laptop screen when I read this.... I was drinking a glass of tea when I was scrolling and read this line.... bwahahaha.... MAN I can't wait to insult my boss with this one. He's a nerdy engineer and it fits him perfectly, ha.... whew, man. My woman is a little mad because the tea went on her couch.

[asos2000]

LEE

Thanks great one

[ReMark]

"Do you want to see the exponential growth of my natural log?":shock:

 

My coworkers want to know what the heck is so funny. :lol:

[Lee Mac]

LEE

Thanks great one

 

Thanks Hasan

 

"Do you want to see the exponential growth of my natural log?":shock:

 

My coworkers want to know what the heck is so funny. :lol:

 

Haha I think you've got to be a true nerd to revel in these jokes...

[chulse]

...Haha I think you've got to be a true nerd to revel in these jokes...

 

Guilty...

 

funny stuff.

[alanjt]

Holy crap Alan I seriously almost ruined my laptop screen when I read this.... I was drinking a glass of tea when I was scrolling and read this line.... bwahahaha.... MAN I can't wait to insult my boss with this one. He's a nerdy engineer and it fits him perfectly, ha.... whew, man. My woman is a little mad because the tea went on her couch.

LoL

 

Haha I think you've got to be a true nerd to revel in these jokes...

So true.

[Lee Mac]

Code updated as per theSwamp

[alanjt]

I just thought about this. LayIso didn't become a native command until '08; before that it was an Express Tool LISP.

[manirpg]

Nice one............Thanks lot MR.Lee:D:D:D

[Lee Mac]

You're welcome

[K P Senthil Kumar]

Hi Gud affternoon to all,

 

Can u tell how to create lisp program (easy method )

[asos2000]

its very easy

this site a very good to start

http://www.afralisp.net/index.php

[K P Senthil Kumar]

hi i try to download but its taking lot of time. So pls can u send me that file in attachment. if its possible means Pls.

regards,

kpsk

[asos2000]

Do downloading needed

Its normal webpage

Click on link the page will be opened automaticaly