mdbdesign Posted October 1, 2011 Author Share Posted October 1, 2011 HI JACK lee , please code for select multi rectangle and delete them. I think you need to start new thread, unless Lee will do it, but it got nothing to do with centerline in rectangle... Quote Link to comment Share on other sites More sharing options...
git_thailand Posted October 2, 2011 Share Posted October 2, 2011 Sorry Sorry ! Quote Link to comment Share on other sites More sharing options...
martinle Posted November 2, 2011 Share Posted November 2, 2011 Hello Master Lee Mac! This is a great Lisp. Is it possible to convert this Lisp Sun at each vertex of a selected polyline (rectangles only) a xline runs vertically or horizontally. It would be great if it would work in all ucs. Thank you very much. love Martin Another Vanilla LISP version for LightWeight Polylines: [ATTACH]30239[/ATTACH] ([color=BLUE]defun[/color] c:polycen ( [color=BLUE]/[/color] a b c e l x ) [color=GREEN];; Example by Lee Mac 2011 - www.lee-mac.com[/color] ([color=BLUE]setq[/color] x 0.1) [color=GREEN];; Line Extension[/color] ([color=BLUE]while[/color] ([color=BLUE]progn[/color] ([color=BLUE]setvar[/color] 'ERRNO 0) ([color=BLUE]setq[/color] e ([color=BLUE]car[/color] ([color=BLUE]entsel[/color] [color=MAROON]"\nSelect LWPolyline: "[/color]))) ([color=BLUE]cond[/color] ( ([color=BLUE]=[/color] 7 ([color=BLUE]getvar[/color] 'ERRNO)) ([color=BLUE]princ[/color] [color=MAROON]"\nMissed, Try again."[/color]) ) ( ([color=BLUE]eq[/color] 'ENAME ([color=BLUE]type[/color] e)) ([color=BLUE]if[/color] ([color=BLUE]not[/color] ([color=BLUE]eq[/color] [color=MAROON]"LWPOLYLINE"[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 0 ([color=BLUE]entget[/color] e))))) ([color=BLUE]princ[/color] [color=MAROON]"\nInvalid Object."[/color]) ) ) ) ) ) ([color=BLUE]if[/color] e ([color=BLUE]progn[/color] ([color=BLUE]setq[/color] l ([color=BLUE]apply[/color] '[color=BLUE]append[/color] ([color=BLUE]mapcar[/color] ([color=BLUE]function[/color] ([color=BLUE]lambda[/color] ( x ) ([color=BLUE]if[/color] ([color=BLUE]=[/color] 10 ([color=BLUE]car[/color] x)) ([color=BLUE]list[/color] ([color=BLUE]trans[/color] ([color=BLUE]cdr[/color] x) e 1))) ) ) ([color=BLUE]entget[/color] e) ) ) ) ([color=BLUE]setq[/color] l ([color=BLUE]mapcar[/color] ([color=BLUE]function[/color] ([color=BLUE]lambda[/color] ( x ) ([color=BLUE]apply[/color] '[color=BLUE]mapcar[/color] ([color=BLUE]cons[/color] x l)) ) ) '([color=BLUE]min[/color] [color=BLUE]max[/color]) ) ) ([color=BLUE]setq[/color] c ([color=BLUE]apply[/color] '[color=BLUE]mapcar[/color] ([color=BLUE]cons[/color] ([color=BLUE]function[/color] ([color=BLUE]lambda[/color] ( a b ) ([color=BLUE]/[/color] ([color=BLUE]+[/color] a b) 2.0)) ) l ) ) ) ([color=BLUE]setq[/color] a ([color=BLUE]*[/color] x ([color=BLUE]-[/color] ([color=BLUE]caadr[/color] l) ([color=BLUE]caar[/color] l))) b ([color=BLUE]*[/color] x ([color=BLUE]-[/color] ([color=BLUE]cadadr[/color] l) ([color=BLUE]cadar[/color] l))) ) ([color=BLUE]entmakex[/color] ([color=BLUE]list[/color] ([color=BLUE]cons[/color] 0 [color=MAROON]"LINE"[/color]) ([color=BLUE]cons[/color] 10 ([color=BLUE]trans[/color] ([color=BLUE]list[/color] ([color=BLUE]-[/color] ([color=BLUE]caar[/color] l) a) ([color=BLUE]cadr[/color] c)) 1 0)) ([color=BLUE]cons[/color] 11 ([color=BLUE]trans[/color] ([color=BLUE]list[/color] ([color=BLUE]+[/color] ([color=BLUE]caadr[/color] l) a) ([color=BLUE]cadr[/color] c)) 1 0)) ) ) ([color=BLUE]entmakex[/color] ([color=BLUE]list[/color] ([color=BLUE]cons[/color] 0 [color=MAROON]"LINE"[/color]) ([color=BLUE]cons[/color] 10 ([color=BLUE]trans[/color] ([color=BLUE]list[/color] ([color=BLUE]car[/color] c) ([color=BLUE]-[/color] ([color=BLUE]cadar[/color] l) b)) 1 0)) ([color=BLUE]cons[/color] 11 ([color=BLUE]trans[/color] ([color=BLUE]list[/color] ([color=BLUE]car[/color] c) ([color=BLUE]+[/color] ([color=BLUE]cadadr[/color] l) b)) 1 0)) ) ) ) ) ([color=BLUE]princ[/color]) ) Should work in all UCS/Views and all shapes of Polyline. Quote Link to comment Share on other sites More sharing options...
antistar Posted November 3, 2011 Share Posted November 3, 2011 Another Vanilla LISP version for LightWeight Polylines: [ATTACH]30239[/ATTACH] ([color=BLUE]defun[/color] c:polycen ( [color=BLUE]/[/color] a b c e l x ) [color=GREEN];; Example by Lee Mac 2011 - www.lee-mac.com[/color] ([color=BLUE]setq[/color] x 0.1) [color=GREEN];; Line Extension[/color] ([color=BLUE]while[/color] ([color=BLUE]progn[/color] ([color=BLUE]setvar[/color] 'ERRNO 0) ([color=BLUE]setq[/color] e ([color=BLUE]car[/color] ([color=BLUE]entsel[/color] [color=MAROON]"\nSelect LWPolyline: "[/color]))) ([color=BLUE]cond[/color] ( ([color=BLUE]=[/color] 7 ([color=BLUE]getvar[/color] 'ERRNO)) ([color=BLUE]princ[/color] [color=MAROON]"\nMissed, Try again."[/color]) ) ( ([color=BLUE]eq[/color] 'ENAME ([color=BLUE]type[/color] e)) ([color=BLUE]if[/color] ([color=BLUE]not[/color] ([color=BLUE]eq[/color] [color=MAROON]"LWPOLYLINE"[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 0 ([color=BLUE]entget[/color] e))))) ([color=BLUE]princ[/color] [color=MAROON]"\nInvalid Object."[/color]) ) ) ) ) ) ([color=BLUE]if[/color] e ([color=BLUE]progn[/color] ([color=BLUE]setq[/color] l ([color=BLUE]apply[/color] '[color=BLUE]append[/color] ([color=BLUE]mapcar[/color] ([color=BLUE]function[/color] ([color=BLUE]lambda[/color] ( x ) ([color=BLUE]if[/color] ([color=BLUE]=[/color] 10 ([color=BLUE]car[/color] x)) ([color=BLUE]list[/color] ([color=BLUE]trans[/color] ([color=BLUE]cdr[/color] x) e 1))) ) ) ([color=BLUE]entget[/color] e) ) ) ) ([color=BLUE]setq[/color] l ([color=BLUE]mapcar[/color] ([color=BLUE]function[/color] ([color=BLUE]lambda[/color] ( x ) ([color=BLUE]apply[/color] '[color=BLUE]mapcar[/color] ([color=BLUE]cons[/color] x l)) ) ) '([color=BLUE]min[/color] [color=BLUE]max[/color]) ) ) ([color=BLUE]setq[/color] c ([color=BLUE]apply[/color] '[color=BLUE]mapcar[/color] ([color=BLUE]cons[/color] ([color=BLUE]function[/color] ([color=BLUE]lambda[/color] ( a b ) ([color=BLUE]/[/color] ([color=BLUE]+[/color] a b) 2.0)) ) l ) ) ) ([color=BLUE]setq[/color] a ([color=BLUE]*[/color] x ([color=BLUE]-[/color] ([color=BLUE]caadr[/color] l) ([color=BLUE]caar[/color] l))) b ([color=BLUE]*[/color] x ([color=BLUE]-[/color] ([color=BLUE]cadadr[/color] l) ([color=BLUE]cadar[/color] l))) ) ([color=BLUE]entmakex[/color] ([color=BLUE]list[/color] ([color=BLUE]cons[/color] 0 [color=MAROON]"LINE"[/color]) ([color=BLUE]cons[/color] 10 ([color=BLUE]trans[/color] ([color=BLUE]list[/color] ([color=BLUE]-[/color] ([color=BLUE]caar[/color] l) a) ([color=BLUE]cadr[/color] c)) 1 0)) ([color=BLUE]cons[/color] 11 ([color=BLUE]trans[/color] ([color=BLUE]list[/color] ([color=BLUE]+[/color] ([color=BLUE]caadr[/color] l) a) ([color=BLUE]cadr[/color] c)) 1 0)) ) ) ([color=BLUE]entmakex[/color] ([color=BLUE]list[/color] ([color=BLUE]cons[/color] 0 [color=MAROON]"LINE"[/color]) ([color=BLUE]cons[/color] 10 ([color=BLUE]trans[/color] ([color=BLUE]list[/color] ([color=BLUE]car[/color] c) ([color=BLUE]-[/color] ([color=BLUE]cadar[/color] l) b)) 1 0)) ([color=BLUE]cons[/color] 11 ([color=BLUE]trans[/color] ([color=BLUE]list[/color] ([color=BLUE]car[/color] c) ([color=BLUE]+[/color] ([color=BLUE]cadadr[/color] l) b)) 1 0)) ) ) ) ) ([color=BLUE]princ[/color]) ) Should work in all UCS/Views and all shapes of Polyline. Hi Lee, Great work is very helpful to me. However, the routine selects only LWPOLYLINES, how to change to also work with POLYLINES? Thanks in advance. Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted November 3, 2011 Share Posted November 3, 2011 Is it possible to convert this Lisp Sun at each vertex of a selected polyline (rectangles only) a xline runs vertically or horizontally. It would be great if it would work in all ucs. Martin, could you provide a simple diagram of what you are looking to achieve? Hi Lee,Great work is very helpful to me. However, the routine selects only LWPOLYLINES, how to change to also work with POLYLINES? This is not a simple modification to the code, but could be done - I'll see if I have time. Quote Link to comment Share on other sites More sharing options...
antistar Posted November 9, 2011 Share Posted November 9, 2011 Martin, could you provide a simple diagram of what you are looking to achieve? This is not a simple modification to the code, but could be done - I'll see if I have time. Thanks Lee, for your attention. Quote Link to comment Share on other sites More sharing options...
martinle Posted November 9, 2011 Share Posted November 9, 2011 Hello Master Lee! Excuse me if I am only now reportable. I've attached a picture so they understand what I mean. Best regards Martin Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted November 9, 2011 Share Posted November 9, 2011 (edited) martinle said: Excuse me if I am only now reportable. I've attached a picture so they understand what I mean. Best regards Martin This was really fun to write (defun c:pxl ( / e ) (defun _lwvertices ( e / p ) (if (setq p (assoc 10 e)) (cons (cdr p) (_lwvertices (cdr (member p e)))) ) ) (defun _polyvertices ( e ) (if (eq "VERTEX" (cdr (assoc 0 (entget e)))) (cons (cdr (assoc 10 (entget e))) (_polyvertices (entnext e))) ) ) (defun _vertices ( e ) (if (eq "POLYLINE" (cdr (assoc 0 (entget e)))) (_polyvertices (entnext e)) (_lwvertices (entget e)) ) ) (defun _selectif ( m f / e ) (setq f (eval f)) (while (progn (setvar 'ERRNO 0) (setq e (car (entsel m))) (cond ( (= 7 (getvar 'ERRNO)) (princ "\nMissed, try again.") ) ( (eq 'ENAME (type e)) (if (not (f e)) (princ "\nInvalid Object.")) ) ) ) ) e ) (if (setq e (_selectif "\nSelect Polyline: " '(lambda ( x ) (wcmatch (cdr (assoc 0 (entget x))) "*POLYLINE")) ) ) ( (lambda ( l ) (mapcar (function (lambda ( a b ) (entmakex (list '(0 . "XLINE") '(100 . "AcDbEntity") '(100 . "AcDbXline") (cons 10 (trans a e 0)) (cons 11 (trans (mapcar '- b a) e 0)) ) ) ) ) l (cons (last l) l) ) ) (_vertices e) ) ) (princ) ) Will work for any shape of LWPolylines / Polylines, in all UCS. Edited October 4, 2019 by Lee Mac Quote Link to comment Share on other sites More sharing options...
martinle Posted November 9, 2011 Share Posted November 9, 2011 Hello Mr. Lee! Great! Would it be possible selection only horizontally or only vertically xlines? Best regards Martin Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted November 9, 2011 Share Posted November 9, 2011 Martin, This is all the voluntary time I am willing to commit to this program; if you require further modification you can contact me directly, either using the PM system, or through my website. Lee Quote Link to comment Share on other sites More sharing options...
martinle Posted November 9, 2011 Share Posted November 9, 2011 Hello Mr. Lee! You are the master! Without a doubt, and I admire their efforts here in the forum! Thank you very much! Best regards Martin Quote Link to comment Share on other sites More sharing options...
Lippens Infra Posted October 4, 2019 Share Posted October 4, 2019 Hi, I'm new to the LISP department of autocad/bricscad. I was in need of this function as well. The only one i could get to work on my bricscad is this one. now i have the issue that i have rotated rectangles. Can i add some line(s) to get my center lines rotated along with the rectangles? thanks y'all. On 9/27/2011 at 6:49 PM, Tharwat said: (defun c:TesT (/ ss e lst Vlen Hlen c p1 p2 p3 p4) ;;; Tharwat 27. Sep. 2011 ;;; (if (and (setq ss (ssget "_+.:S:L" '((0 . "LWPOLYLINE")))) (member (cdr (assoc 0 (setq e (entget (ssname ss 0))))) '("LWPOLYLINE" "POLYLINE") ) (eq (vlax-curve-getendparam (ssname ss 0)) 4.0) ) (progn (setq lst (vl-remove-if-not (function (lambda (x) (eq (car x) 10))) e) ) (setq Vlen (distance (nth 0 lst) (nth 1 lst))) (setq Hlen (distance (nth 1 lst) (nth 2 lst))) (setq c (inters (nth 0 lst) (nth 2 lst) (nth 1 lst) (nth 3 lst))) (setq p1 (polar (setq c (list (cadr c) (caddr c) 0.0)) pi (+ (/ Vlen 2.) (/ Vlen 10.)) ) ) (setq p2 (polar p1 0. (+ Vlen (/ Vlen 5.)))) (setq p3 (polar c (/ pi 2.) (+ (/ Hlen 2.) (/ Hlen 10.)))) (setq p4 (polar p3 (+ (/ pi 2.) pi) (+ Hlen (/ Hlen 5.)))) (entmakex (list '(0 . "LINE") (cons 10 p1) (cons 11 p2))) (entmakex (list '(0 . "LINE") (cons 10 p3) (cons 11 p4))) ) (princ) ) (princ) ) Tharwat Quote Link to comment Share on other sites More sharing options...
Tharwat Posted October 4, 2019 Share Posted October 4, 2019 7 hours ago, Lippens Infra said: Can i add some line(s) to get my center lines rotated along with the rectangles? Hi, Yes its possible so try the following and let me know. NOTE: You can change the gap value 5.0 in the routine which represents the extended offset distance from the two sides of the selected rectangle and what's more importantly is that you can now select as many as you would like of rectangles with one shot. (defun c:Test (/ gap int sel ent vr1 vr2 vr3 vr4 ctr) ;; Tharwat 04.10.2019 ;; (and (setq gap 5.0 int -1 sel (ssget '((0 . "LWPOLYLINE") (90 . 4))) ) (while (setq int (1+ int) ent (ssname sel int) ) (mapcar 'set '(vr1 vr2 vr3 vr4) (mapcar 'cdr (vl-remove-if-not '(lambda (x) (eq (car x) 10)) (entget ent) ) ) ) (setq ctr (inters vr1 vr3 vr2 vr4)) (mapcar '(lambda (x / j k d a o) (mapcar 'set '(j k) x) (setq d (/ (distance j k) 2.0) a (angle j k) o (+ d gap) ) (entmake (list '(0 . "LINE") (cons 10 (polar ctr a o)) (cons 11 (polar ctr (+ a pi) o)) ) ) ) (list (list vr1 vr2) (list vr2 vr3)) ) ) ) (princ) ) (vl-load-com) Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted October 4, 2019 Share Posted October 4, 2019 I have updated my earlier posts to remove the BBCode formatting tags. 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.