autolisp Posted August 31, 2010 Share Posted August 31, 2010 (edited) dear all autolisp & suggestion how to improve this lisp thx for help (defun c:IC (/ intlist ptemp sset set0 set1 selset e lay lay0 i k l n y z p1 p2 p3 p4 p5 p6 int1 int2 ) (setvar "CMDECHO" 0) (setq sset (ssget "C" (setq p (getpoint "First pt: ")) (getcorner p "Other pt: ") ) ) (setq n (sslength sset) i 1 lay0 (assoc 8 (entget (ssname sset 0))) set0 (ssadd (ssname sset 0)) set1 (ssadd) ) (repeat (- n 1) (setq lay (assoc 8 (entget (setq e (ssname sset i))))) (if (equal lay lay0) (ssadd e set0) (ssadd e set1) ) (setq i (1+ i)) ) (if (> (sslength set0) (sslength set1)) (setq selset set0) (setq selset set1) ) (setq n (sslength selset) i 0 ) (repeat (- n 1) (setq k (1+ i)) (while (< k n) (if (/= (inters (cdr (assoc 10 (entget (ssname selset i)))) (cdr (assoc 11 (entget (ssname selset i)))) (cdr (assoc 10 (entget (ssname selset k)))) (cdr (assoc 11 (entget (ssname selset k)))) ) nil ) (setq intlist (append intlist (list (strcat (itoa i) (itoa k)))) ) ) (setq k (1+ k)) ) (setq i (1+ i)) ) (setq n (length intlist) i 0 ) (repeat (- n 1) (setq k (1+ i)) (while (< k n) (cond ((= (substr (nth i intlist) 1 1) (substr (nth k intlist) 1 1) ) (setq l (atoi (substr (nth i intlist) 1 1))) ) ((= (substr (nth i intlist) 2 1) (substr (nth k intlist) 1 1) ) (setq l (atoi (substr (nth i intlist) 2 1))) ) ((= (substr (nth i intlist) 1 1) (substr (nth k intlist) 2 1) ) (setq l (atoi (substr (nth k intlist) 1 1))) ) ((= (substr (nth i intlist) 2 1) (substr (nth k intlist) 2 1) ) (setq l (atoi (substr (nth k intlist) 2 1))) ) ) (setq y nil z nil ) (if (/= l nil) (progn (setq ptemp (append (list (nth i intlist)) (list (nth k intlist ) ) ) ) (foreach x ptemp (cond ((= (atoi (substr x 1 1)) l) (setq y (atoi (substr x 2 ) ) ) ) ((= (atoi (substr x 2)) l) (setq y (atoi (substr x 1 1 ) ) ) ) ) (if (and (/= y nil) (= z nil) ) (setq z y y nil ) ) ) ) ) (setq l nil k (1+ k) ) ) (setq i (1+ i)) ) (SETVAR "CMDECHO" 1) ) Edited September 1, 2010 by autolisp Quote Link to comment Share on other sites More sharing options...
Tharwat Posted August 31, 2010 Share Posted August 31, 2010 Hi, What's the action of your codes, It contains lots of different return values but would implementing nothing. Quote Link to comment Share on other sites More sharing options...
The Buzzard Posted August 31, 2010 Share Posted August 31, 2010 dear allchk my new lisp & suggestion how to improve this lisp thx for help (defun c:IC (/ intlist ptemp sset set0 set1 selset e lay lay0 i k l n y z p1 p2 p3 p4 p5 p6 int1 int2 ) (setvar "CMDECHO" 0) (setq sset (ssget "C" (setq p (getpoint "First pt: ")) (getcorner p "Other pt: ") ) ) (setq n (sslength sset) i 1 lay0 (assoc 8 (entget (ssname sset 0))) set0 (ssadd (ssname sset 0)) set1 (ssadd) ) (repeat (- n 1) (setq lay (assoc 8 (entget (setq e (ssname sset i))))) (if (equal lay lay0) (ssadd e set0) (ssadd e set1) ) (setq i (1+ i)) ) (if (> (sslength set0) (sslength set1)) (setq selset set0) (setq selset set1) ) (setq n (sslength selset) i 0 ) (repeat (- n 1) (setq k (1+ i)) (while (< k n) (if (/= (inters (cdr (assoc 10 (entget (ssname selset i)))) (cdr (assoc 11 (entget (ssname selset i)))) (cdr (assoc 10 (entget (ssname selset k)))) (cdr (assoc 11 (entget (ssname selset k)))) ) nil ) (setq intlist (append intlist (list (strcat (itoa i) (itoa k)))) ) ) (setq k (1+ k)) ) (setq i (1+ i)) ) (setq n (length intlist) i 0 ) (repeat (- n 1) (setq k (1+ i)) (while (< k n) (cond ((= (substr (nth i intlist) 1 1) (substr (nth k intlist) 1 1) ) (setq l (atoi (substr (nth i intlist) 1 1))) ) ((= (substr (nth i intlist) 2 1) (substr (nth k intlist) 1 1) ) (setq l (atoi (substr (nth i intlist) 2 1))) ) ((= (substr (nth i intlist) 1 1) (substr (nth k intlist) 2 1) ) (setq l (atoi (substr (nth k intlist) 1 1))) ) ((= (substr (nth i intlist) 2 1) (substr (nth k intlist) 2 1) ) (setq l (atoi (substr (nth k intlist) 2 1))) ) ) (setq y nil z nil ) (if (/= l nil) (progn (setq ptemp (append (list (nth i intlist)) (list (nth k intlist ) ) ) ) (foreach x ptemp (cond ((= (atoi (substr x 1 1)) l) (setq y (atoi (substr x 2 ) ) ) ) ((= (atoi (substr x 2)) l) (setq y (atoi (substr x 1 1 ) ) ) ) ) (if (and (/= y nil) (= z nil) ) (setq z y y nil ) ) ) (setq p1 (cdr (assoc 10 (entget (ssname selset l)))) p2 (cdr (assoc 11 (entget (ssname selset l)))) p3 (cdr (assoc 10 (entget (ssname selset y)))) p4 (cdr (assoc 11 (entget (ssname selset y)))) p5 (cdr (assoc 10 (entget (ssname selset z)))) p6 (cdr (assoc 11 (entget (ssname selset z)))) int1 (inters p1 p2 p3 p4 nil) int2 (inters p1 p2 p5 p6 nil) ) (command "Break" (ssname selset l) int1 int2) ) ) (setq l nil k (1+ k) ) ) (setq i (1+ i)) ) (SETVAR "CMDECHO" 1) ) No disrespect intended, But a few times you have posted code leaving me with the impression that you wrote it as you refer to it as YOUR NEW LISP. You say very little about the code itself other than you want to improve it, So I decided to look into this a bit. If this is in fact your new lisp, I suggest you be very clear on this. If this is not your code please make sure you have permission to post it. Below is the same code on another site, But it says this code was published January 1991 at Cadence Magazine. The lisp was call INTCLEAN.lsp and it seems you changed it to IC.lsp I am assuming. http://www.hispacad.com/foro/viewtopic.php?p=65769&sid=e55ea029bdd66a2f861067a6e48a4d4b Quote Link to comment Share on other sites More sharing options...
BlackBox Posted August 31, 2010 Share Posted August 31, 2010 Wow. How about trying a few of these: vla-getboundingbox vlax-for, if not foreach vlax-curve-getstartpoint vlax-curve-getendpoint Quote Link to comment Share on other sites More sharing options...
BIGAL Posted September 1, 2010 Share Posted September 1, 2010 Also a description of what its trying to do would have been good in the very first post just the lisp name means nothing and if it works for you why ask for comments! Rather ask specific how to improve maybe a missing function that would benefit the routine or how to reduce picks etc Like Renderman he has at least suggested options. 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.