Lee Mac Posted May 24, 2010 Share Posted May 24, 2010 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) ) ) 1 Quote Link to comment Share on other sites More sharing options...
ReMark Posted May 24, 2010 Share Posted May 24, 2010 Lee: Nice routine. Now it's time to design that perfect pick-up line for the girls. Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted May 24, 2010 Author Share Posted May 24, 2010 Haha cheers Mark Quote Link to comment Share on other sites More sharing options...
stevesfr Posted May 24, 2010 Share Posted May 24, 2010 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'.... Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted May 24, 2010 Author Share Posted May 24, 2010 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: Quote Link to comment Share on other sites More sharing options...
alanjt Posted May 25, 2010 Share Posted May 25, 2010 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? Quote Link to comment Share on other sites More sharing options...
tzframpton Posted May 25, 2010 Share Posted May 25, 2010 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. Quote Link to comment Share on other sites More sharing options...
asos2000 Posted May 25, 2010 Share Posted May 25, 2010 LEE Thanks great one Quote Link to comment Share on other sites More sharing options...
ReMark Posted May 25, 2010 Share Posted May 25, 2010 "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: Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted May 25, 2010 Author Share Posted May 25, 2010 LEEThanks 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... Quote Link to comment Share on other sites More sharing options...
chulse Posted May 25, 2010 Share Posted May 25, 2010 ...Haha I think you've got to be a true nerd to revel in these jokes... Guilty... funny stuff. Quote Link to comment Share on other sites More sharing options...
alanjt Posted May 25, 2010 Share Posted May 25, 2010 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. Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted May 25, 2010 Author Share Posted May 25, 2010 Code updated as per theSwamp Quote Link to comment Share on other sites More sharing options...
alanjt Posted May 25, 2010 Share Posted May 25, 2010 I just thought about this. LayIso didn't become a native command until '08; before that it was an Express Tool LISP. Quote Link to comment Share on other sites More sharing options...
manirpg Posted May 26, 2010 Share Posted May 26, 2010 Nice one............Thanks lot MR.Lee:D:D:D Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted May 26, 2010 Author Share Posted May 26, 2010 You're welcome Quote Link to comment Share on other sites More sharing options...
K P Senthil Kumar Posted May 27, 2010 Share Posted May 27, 2010 Hi Gud affternoon to all, Can u tell how to create lisp program (easy method ) Quote Link to comment Share on other sites More sharing options...
asos2000 Posted May 27, 2010 Share Posted May 27, 2010 its very easy this site a very good to start http://www.afralisp.net/index.php Quote Link to comment Share on other sites More sharing options...
K P Senthil Kumar Posted May 27, 2010 Share Posted May 27, 2010 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 Quote Link to comment Share on other sites More sharing options...
asos2000 Posted May 27, 2010 Share Posted May 27, 2010 Do downloading needed Its normal webpage Click on link the page will be opened automaticaly Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.