Jump to content

Upgraded LayIso


Lee Mac

Recommended Posts

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

hl.gif

 

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

  • Like 1
Link to comment
Share on other sites

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'....

Link to comment
Share on other sites

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: :lol:

Link to comment
Share on other sites

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?

Link to comment
Share on other sites

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. :oops:

Link to comment
Share on other sites

"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::lol::lol:

Link to comment
Share on other sites

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::lol::lol:

 

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

Link to comment
Share on other sites

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. :oops:

LoL

 

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

So true.

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...