Visual LISP, AutoLISP and General Customization

Reply
Member
zorroxxxx
Posts: 5
Registered: ‎07-11-2004
Message 1 of 21 (140 Views)

LISP for intersection clean up

140 Views, 20 Replies
07-11-2004 07:48 PM
Hi,

Does anyone have a LISP or Script that will clean up intersections? Both linear and radius intersections. I have been constantly trimming and after a few hundred thousand clicks, I figure there has to be an easier way. I've also have tried using BPOLY command but it creates polylines on top of existing lines, which I then have to delete. I am just learning LISP so I'm not sure how to conquer this problem.

I have attached a .BMP file which shows exactly what I'm looking for.

I run Vanilla ACAD 2002

Any help will be greatly appreciated

Gary
Distinguished Contributor
EC-CAD
Posts: 5,929
Registered: ‎12-12-2003
Message 2 of 21 (140 Views)

Re: LISP for intersection clean up

07-12-2004 09:52 AM in reply to: zorroxxxx
Zorroxxxx (what a handle),
This will get you started. Pick vectors 'top', 'right', 'bottom', and 'left'..(clockwize from top......to left).


;; Lisp to cleanup intersections..for style A, B
(defun C:CI ()
(prompt "\nPick (4) lines {Clockwise} that intersect:")
(setq l1 (entsel "\nPick 1st line:"))
(setq p1 (car (cdr l1)))
(setq l2 (entsel "\nPick 2nd line:"))
(setq p2 (car (cdr l2)))
(setq l3 (entsel "\nPick 3rd line:"))
(setq p3 (car (cdr l3)))
(setq l4 (entsel "\nPick 4th line:"))
(setq p4 (car (cdr l4)))
(command "_trim" l4 l2 "" l1 l3 ""); Trim Lines 1 and 3
;; get next set of vectors..
(setq pc1 (list (+ (car p2) 0.01)(+ (cadr p1) 0.01)))
(setq pc2 (list (+ (car p2) 0.01)(- (cadr p3) 0.01)))
(setq ss2 (ssget "c" pc1 pc2))
(if ss2
(progn
(setq v1 (ssname ss2 0) v2 (ssname ss2 1))
(command "_trim" v1 v2 "" l2 ""); Trim Line 2
); progn
); if
;; get next set of vectors..
(setq pc1 (list (- (car p4) 0.01)(+ (cadr p1) 0.01)))
(setq pc2 (list (- (car p4) 0.01)(- (cadr p3) 0.01)))
(setq ss2 (ssget "c" pc1 pc2))
(if ss2
(progn
(setq v1 (ssname ss2 0) v2 (ssname ss2 1))
(command "_trim" v1 v2 "" l4 ""); Trim Line 4
); progn
); if
(princ)
); end function

Bob
*Rudy Tovar
Message 3 of 21 (140 Views)

Re: LISP for intersection clean up

07-12-2004 09:56 AM in reply to: zorroxxxx
Try MASi 'WallTools'. Give it a whirl...see docs.. -- Rudy@Cadentity.com AUTODESK Authorized Developer http://www.Cadentity.com MASi "zorroxxxx" wrote in message news:23677122.1089600569583.JavaMail.jive@jiveforum2.autodesk.com... > Hi, > > Does anyone have a LISP or Script that will clean up intersections? Both linear and radius intersections. I have been constantly trimming and after a few hundred thousand clicks, I figure there has to be an easier way. I've also have tried using BPOLY command but it creates polylines on top of existing lines, which I then have to delete. I am just learning LISP so I'm not sure how to conquer this problem. > > I have attached a .BMP file which shows exactly what I'm looking for. > > I run Vanilla ACAD 2002 > > Any help will be greatly appreciated > > Gary
Distinguished Contributor
aewatson
Posts: 264
Registered: ‎12-05-2003
Message 4 of 21 (140 Views)

Re: LISP for intersection clean up

07-12-2004 09:56 AM in reply to: zorroxxxx
Gary,

I started working on a routine to do that some time ago. This would be a fairly difficult program if you're just learning.

I attached a .vlx (encrypted) version of what I have so far. The routine will take user-selected lines and arcs and redraw them as if the user had performed a "break" at every interesection of every entity. So it gets you half way to where you'd like to be, since you still have to erase the inner lines and arcs of your intersections. You could argue it would take just as long to issue a TRIM command, select everything, and then just pick the inner entities. However, if the number of intersections you'd like to use this on was significant, the attached routine would at least make the inner pieces individual entities that could then be erased with a window?

Maybe you can get someone else to write the second part of the routine for you, where you somehow pick a point within your intersection and it figures out which "broken" entities it needs to erase.

Andrew
*Rudy Tovar
Message 5 of 21 (140 Views)

Re: LISP for intersection clean up

07-12-2004 09:58 AM in reply to: zorroxxxx
Sorry no 'Arcs'. But you'll see... -- Rudy@Cadentity.com AUTODESK Authorized Developer http://www.Cadentity.com MASi "zorroxxxx" wrote in message news:23677122.1089600569583.JavaMail.jive@jiveforum2.autodesk.com... > Hi, > > Does anyone have a LISP or Script that will clean up intersections? Both linear and radius intersections. I have been constantly trimming and after a few hundred thousand clicks, I figure there has to be an easier way. I've also have tried using BPOLY command but it creates polylines on top of existing lines, which I then have to delete. I am just learning LISP so I'm not sure how to conquer this problem. > > I have attached a .BMP file which shows exactly what I'm looking for. > > I run Vanilla ACAD 2002 > > Any help will be greatly appreciated > > Gary
*GaryDF
Message 6 of 21 (140 Views)

Re: LISP for intersection clean up

07-12-2004 01:04 PM in reply to: zorroxxxx
Try these out...... ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Sub Functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun ARCH:LN (ey ex z intz dltl / an2 an3 an4 an5 crs1 san2 san5) (command "_layer" "_S" z "") (setq an2 (angle intz ex)) (setq an3 (angle intz dltl)) (setq an5 (angle intz ey)) (setq san2 (rtos an2 2 1)) (setq san5 (rtos an5 2 1)) (setq si-an2 (atof san2)) (setq si-an5 (atof san5)) (if (<= (distance ey intz) 0.01) (setq ey ex) ) ;if lines end at inters (if (<= (distance ex intz) 0.01) (setq ex ey) ) (if (= san2 san5) (progn ;if lines are short of inters (setq ex (ARCH:FAR ex ey intz)) ;set both endpoints eq to farthst (setq ey ex) ) ) (if (/= tst 1) (progn (cond ((and (>= an3 4.71) (<= an2 (- an3 4.71))) (setq an2 (+ an2 4.71)) ) ((and (<= an3 1.57) (>= an2 (+ an3 4.71))) (setq an2 (- an2 4.71)) ) ) (setq an4 (- an3 an2)) (if (>= (abs an4) 1.57079) (command ".line" ey intz "") (command ".line" ex intz "") ) ) (progn (setq crs1 (abs (- an3 an2))) (cond ((and (and (> crs1 0.39) (< crs1 5.89)) (or (> crs1 3.53) (< crs1 2.75)) ) (command ".line" ex ey "") ) ) ) ) (setq ex nil ey nil ) ) (defun ARCH:NEAR (nx ny dlxn / dst1 dst2) (setq dst1 (distance dlxn nx)) (setq dst2 (distance dlxn ny)) (if (< dst1 dst2) (eval 'nx) (eval 'ny) ) ) (defun ARCH:FAR (fx fy dlxf / dst1 dst2) (setq dst1 (distance dlxf fx)) (setq dst2 (distance dlxf fy)) (if (> dst1 dst2) (eval 'fx) (eval 'fy) ) ) (defun ARCH:smileyvery-happy:RWC (dlxd dltd / int1) (if (/= alst nil) (setq int1 alst) ) (if (/= blst nil) (setq int1 blst) ) (if (/= clst nil) (setq int1 clst) ) (if (/= dlst nil) (setq int1 dlst) ) (if (/= elst nil) (setq int1 elst) ) (if (/= flst nil) (setq int1 flst) ) (if (/= alst nil) (setq int1 (ARCH:NEAR int1 alst dlxd)) ) (if (/= blst nil) (setq int1 (ARCH:NEAR int1 blst dlxd)) ) (if (/= clst nil) (setq int1 (ARCH:NEAR int1 clst dlxd)) ) (if (/= dlst nil) (setq int1 (ARCH:NEAR int1 dlst dlxd)) ) (if (/= elst nil) (setq int1 (ARCH:NEAR int1 elst dlxd)) ) (if (/= flst nil) (setq int1 (ARCH:NEAR int1 flst dlxd)) ) (cond ((= int1 alst) (ARCH:LN a1 b1 l1 int1 dltd) (ARCH:LN a3 b3 l3 int1 dltd) ) ((= int1 blst) (ARCH:LN a1 b1 l1 int1 dltd) (ARCH:LN a4 b4 l4 int1 dltd) ) ((= int1 clst) (ARCH:LN a2 b2 l2 int1 dltd) (ARCH:LN a3 b3 l3 int1 dltd) ) ((= int1 dlst) (ARCH:LN a2 b2 l2 int1 dltd) (ARCH:LN a4 b4 l4 int1 dltd) ) ((= int1 elst) (ARCH:LN a1 b1 l1 int1 dltd) (ARCH:LN a2 b2 l2 int1 dltd) ) ((= int1 flst) (ARCH:LN a3 b3 l3 int1 dltd) (ARCH:LN a4 b4 l4 int1 dltd) ) ) ) (defun ARCH:CORNR (ca cb / v1 v2 h pt1 pt2) (setq v1 (SSGET "C" ca cb)) (setq v2 0) (setq a1 (cdr (assoc 10 (entget (ssname v1 v2))))) (setq b1 (cdr (assoc 11 (entget (ssname v1 v2))))) (setq l1 (cdr (assoc 8 (entget (ssname v1 v2))))) (setq v2 (+ v2 1)) (setq a2 (cdr (assoc 10 (entget (ssname v1 v2))))) (setq b2 (cdr (assoc 11 (entget (ssname v1 v2))))) (setq l2 (cdr (assoc 8 (entget (ssname v1 v2))))) (setq v2 (+ v2 1)) (setq a3 (cdr (assoc 10 (entget (ssname v1 v2))))) (setq b3 (cdr (assoc 11 (entget (ssname v1 v2))))) (setq l3 (cdr (assoc 8 (entget (ssname v1 v2))))) (setq v2 (+ v2 1)) (setq a4 (cdr (assoc 10 (entget (ssname v1 v2))))) (setq b4 (cdr (assoc 11 (entget (ssname v1 v2))))) (setq l4 (cdr (assoc 8 (entget (ssname v1 v2))))) (setq alst (inters a1 b1 a3 b3 nil)) (setq blst (inters a1 b1 a4 b4 nil)) (setq clst (inters a2 b2 a3 b3 nil)) (setq dlst (inters a2 b2 a4 b4 nil)) (setq elst (inters a1 b1 a2 b2 nil)) (setq flst (inters a3 b3 a4 b4 nil)) ) (defun ARCH:MID (w z) (list (/ (+ (car w) (car z)) 2) (/ (+ (cadr w) (cadr z)) 2)) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Cleanup Routines ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun c:CORNER (/ F1 F2 F3 SSV SSH EN-V1 EN-V2 EN-H1 EN-H2 EL-V1 EL-V2 EL-H1 EL-H2) ;;(ARCH:F_S-VAR) ;;(ARCH:UBEG) (setvar "osmode" 0) (setq F1 (getpoint "\n* First fence point *") F2 (getpoint F1 "\n* Second fence point *") F3 (getpoint F2 "\n* Third fence point *") ) (setq SSV (SSGET "F" (LIST F1 F2)) SSH (SSGET "F" (LIST F2 F3)) EN-V1 (SSNAME SSV 0) EN-V2 (SSNAME SSV 1) EN-H1 (SSNAME SSH 0) EN-H2 (SSNAME SSH 1) EL-V1 (ENTGET EN-V1) EL-V2 (ENTGET EN-V2) EL-H1 (ENTGET EN-H1) EL-H2 (ENTGET EN-H2) V1P1 (CDR (ASSOC 10 EL-V1)) V1P2 (CDR (ASSOC 11 EL-V1)) V2P1 (CDR (ASSOC 10 EL-V2)) V2P2 (CDR (ASSOC 11 EL-V2)) H1P1 (CDR (ASSOC 10 EL-H1)) H1P2 (CDR (ASSOC 11 EL-H1)) H2P1 (CDR (ASSOC 10 EL-H2)) H2P2 (CDR (ASSOC 11 EL-H2)) ) (setq V1 (INTERS V1P1 V1P2 F1 F2) V2 (INTERS V2P1 V2P2 F1 F2) H1 (INTERS H1P1 H1P2 F2 F3) H2 (INTERS H2P1 H2P2 F2 F3) VD1 (DISTANCE F2 V1) VD2 (DISTANCE F2 V2) HD1 (DISTANCE F2 H1) HD2 (DISTANCE F2 H2) ) (if (< VD1 VD2) (setq F-VP1 V1 F-VP2 V2 ) (setq F-VP1 V2 F-VP2 V1 ) ) (if (< HD1 HD2) (setq F-HP1 H1 F-HP2 H2 ) (setq F-HP1 H2 F-HP2 H1 ) ) (setq RADIUS (GETVAR "FILLETRAD")) (setvar "FILLETRAD" 0.0) (command "FILLET" (OSNAP F-VP1 "NEA") (OSNAP F-HP1 "NEA")) (command "FILLET" (OSNAP F-VP2 "NEA") (OSNAP F-HP2 "NEA")) (setvar "FILLETRAD" RADIUS) (print MOD) ;;(ARCH:UEND) ;;(ARCH:F_R-VAR) (princ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; (defun c:CROSS (/ F1 F2 F3 SSV SSH EN-V1 EN-V2 EN-H1 EN-H2 EL-V1 EL-V2 EL-H1 EL-H2) ;;(ARCH:F_S-VAR) ;;(ARCH:UBEG) (setvar "osmode" 0) (setq F1 (getpoint "\n* First fence point *") F2 (getpoint F1 "\n* Second fence point *") F3 (getpoint F2 "\n* Third fence point *") ) (setq SSV (SSGET "F" (LIST F1 F2)) SSH (SSGET "F" (LIST F2 F3)) EN-V1 (SSNAME SSV 0) EN-V2 (SSNAME SSV 1) EN-H1 (SSNAME SSH 0) EN-H2 (SSNAME SSH 1) EL-V1 (ENTGET EN-V1) EL-V2 (ENTGET EN-V2) EL-H1 (ENTGET EN-H1) EL-H2 (ENTGET EN-H2) V1P1 (CDR (ASSOC 10 EL-V1)) V1P2 (CDR (ASSOC 11 EL-V1)) V2P1 (CDR (ASSOC 10 EL-V2)) V2P2 (CDR (ASSOC 11 EL-V2)) H1P1 (CDR (ASSOC 10 EL-H1)) H1P2 (CDR (ASSOC 11 EL-H1)) H2P1 (CDR (ASSOC 10 EL-H2)) H2P2 (CDR (ASSOC 11 EL-H2)) ) (setq P1 (INTERS V1P1 V1P2 H1P1 H1P2 ()) P2 (INTERS V1P1 V1P2 H2P1 H2P2 ()) P3 (INTERS V2P1 V2P2 H1P1 H1P2 ()) P4 (INTERS V2P1 V2P2 H2P1 H2P2 ()) ) (command "BREAK" EN-V1 P1 P2) (command "BREAK" EN-V2 P3 P4) (command "BREAK" EN-H1 P1 P3) (command "BREAK" EN-H2 P2 P4) ;;(ARCH:UEND) ;;(ARCH:F_R-VAR) (PRINC) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; (defun c:TEE (/ F1 F2 F3 SSV SSH EN-V1 EN-V2 EN-H1 EN-H2 EL-V1 EL-V2 EL-H1 EL-H2) ;;(ARCH:F_S-VAR) ;;(ARCH:UBEG) (setvar "osmode" 0) (setq F1 (getpoint "\n* First fence point *") F2 (getpoint F1 "\n* Second fence point *") F3 (getpoint F2 "\n* Third fence point *") ) (setq SSV (SSGET "F" (LIST F1 F2)) SSH (SSGET "F" (LIST F2 F3)) EN-V1 (SSNAME SSV 0) EN-V2 (SSNAME SSV 1) EN-H1 (SSNAME SSH 0) EN-H2 (SSNAME SSH 1) EL-V1 (ENTGET EN-V1) EL-V2 (ENTGET EN-V2) EL-H1 (ENTGET EN-H1) EL-H2 (ENTGET EN-H2) V1P1 (CDR (ASSOC 10 EL-V1)) V1P2 (CDR (ASSOC 11 EL-V1)) V2P1 (CDR (ASSOC 10 EL-V2)) V2P2 (CDR (ASSOC 11 EL-V2)) H1P1 (CDR (ASSOC 10 EL-H1)) H1P2 (CDR (ASSOC 11 EL-H1)) H2P1 (CDR (ASSOC 10 EL-H2)) H2P2 (CDR (ASSOC 11 EL-H2)) ) (setq V1 (INTERS V1P1 V1P2 F1 F2) V2 (INTERS V2P1 V2P2 F1 F2) H1 (INTERS H1P1 H1P2 F2 F3) H2 (INTERS H2P1 H2P2 F2 F3) HD1 (DISTANCE F2 H1) HD2 (DISTANCE F2 H2) ) (if (< HD1 HD2) (setq EN EN-H1 EL (ENTGET EN) EP1 (CDR (ASSOC 10 EL)) EP2 (CDR (ASSOC 11 EL)) ) (setq EN EN-H2 EL (ENTGET EN) EP1 (CDR (ASSOC 10 EL)) EP2 (CDR (ASSOC 11 EL)) ) ) (setq BP1 (INTERS V1P1 V1P2 EP1 EP2 ()) BP2 (INTERS V2P1 V2P2 EP1 EP2 ()) A1 (ANGLE V1 (INTERS V1P1 V1P2 EP2 EP1 ())) A2 (ANGLE V2 (INTERS V2P1 V2P2 EP1 EP2 ())) TP1 (POLAR (INTERS V1P1 V1P2 EP1 EP2 ()) A1 0.001) TP2 (POLAR (INTERS V2P1 V2P2 EP1 EP2 ()) A2 0.001) ) (if (NOT (INTERS V1P1 V1P2 EP1 EP2)) (command ".EXTEND" EN "" V1 "") ) (if (NOT (INTERS V2P1 V2P2 EP1 EP2)) (command ".EXTEND" EN "" V2 "") ) (command ".TRIM" EN "" TP1 TP2 "") (command ".BREAK" EN BP1 BP2) ;;(ARCH:UEND) ;;(ARCH:F_R-VAR) (princ) ) Gary zorroxxxx" wrote in message news:23677122.1089600569583.JavaMail.jive@jiveforum2.autodesk.com... > Hi, > > Does anyone have a LISP or Script that will clean up intersections? Both linear and radius intersections. I have been constantly trimming and after a few hundred thousand clicks, I figure there has to be an easier way. I've also have tried using BPOLY command but it creates polylines on top of existing lines, which I then have to delete. I am just learning LISP so I'm not sure how to conquer this problem. > > I have attached a .BMP file which shows exactly what I'm looking for. > > I run Vanilla ACAD 2002 > > Any help will be greatly appreciated > > Gary
*Joe Burke
Message 7 of 21 (140 Views)

Re: LISP for intersection clean up

07-13-2004 04:54 AM in reply to: zorroxxxx
Gary, Just fooling around with how it might be done without selecting objects. One click, pick point. Seems to work fairly well with arcs and lines given your examples. It's certainly not bulletproof and needs more error checking. Zoom in/out is annoying, but the break commands are more reliable this way. Joe Burke (defun c:CleanIntersections ( / *Error* doc osm pkbx pt tempobj coord ptlst p1 p2 p3 p4 zmpt1 zmpt2 ) (defun *Error* (Msg) (cond ((or (not Msg) (member Msg '("console break" "Function cancelled" "quit / exit abort")))) ((princ (strcat "\nError: " Msg))) ) (setvar "osmode" osm) (setvar "cmdecho" 1) (princ) ) ;end (defun MidPoint (p1 p2) (mapcar '* (mapcar '+ p1 p2) '(0.5 0.5 0.5)) ) ;end (setq doc (vla-get-activedocument (vlax-get-acad-object))) (setq osm (getvar "osmode")) (setvar "osmode" 0) (setvar "cmdecho" 0) (while (setq pt (getpoint "\nPick point inside intersection: ")) (vla-StartUndoMark doc) (command "-boundary" pt "") (setq tempobj (vlax-ename->vla-object (entlast))) (setq coord (vlax-get tempobj 'Coordinates)) (vla-delete tempobj) (repeat 4 (setq ptlst (cons (list (car coord) (cadr coord)) ptlst)) (setq coord (cddr coord)) ) (setq ptlst (mapcar '(lambda (x) (trans x 0 1)) ptlst)) (setq p1 (MidPoint (car ptlst) (cadr ptlst))) (setq p2 (MidPoint (cadr ptlst) (caddr ptlst))) (setq p3 (MidPoint (caddr ptlst) (last ptlst))) (setq p4 (MidPoint (car ptlst) (last ptlst))) (setq zmpt1 (polar pt 0.0 (* (distance p1 p3) 5))) (setq zmpt2 (polar pt pi (* (distance p1 p3) 5))) (command "zoom" "w" zmpt1 zmpt2) (command "_break" p1 "F" (car ptlst) (cadr ptlst) "_break" p2 "F" (cadr ptlst) (caddr ptlst) "_break" p3 "F" (caddr ptlst) (last ptlst) "_break" p4 "F" (car ptlst) (last ptlst)) (command "zoom" "p") (vla-EndUndoMark doc) (setq ptlst nil) ) ;while (*Error* nil) (princ) ) ;end > Hi, > > Does anyone have a LISP or Script that will clean up intersections? Both linear and radius intersections. I have been constantly trimming and after a few hundred thousand clicks, I figure there has to be an easier way. I've also have tried using BPOLY command but it creates polylines on top of existing lines, which I then have to delete. I am just learning LISP so I'm not sure how to conquer this problem. > > I have attached a .BMP file which shows exactly what I'm looking for. > > I run Vanilla ACAD 2002 > > Any help will be greatly appreciated > > Gary
Member
zorroxxxx
Posts: 5
Registered: ‎07-11-2004
Message 8 of 21 (140 Views)

Re: LISP for intersection clean up

07-13-2004 09:39 PM in reply to: zorroxxxx
Problem solved.

Thanks to all who posted.

Gary
*GaryDF
Message 9 of 21 (140 Views)

Re: LISP for intersection clean up

07-14-2004 07:00 AM in reply to: zorroxxxx
Joe, Excellent routines....thanks for sharing it. Gary [_]P "Joe Burke" wrote in message news:40f3cd9a$1_1@newsprd01... > Gary, > > Just fooling around with how it might be done without selecting objects. One click, > pick point. Seems to work fairly well with arcs and lines given your examples. It's > certainly not bulletproof and needs more error checking. Zoom in/out is annoying, but > the break commands are more reliable this way. > > Joe Burke > > (defun c:CleanIntersections ( / *Error* doc osm pkbx pt tempobj coord > ptlst p1 p2 p3 p4 zmpt1 zmpt2 ) > > (defun *Error* (Msg) > (cond > ((or (not Msg) > (member Msg '("console break" > "Function cancelled" > "quit / exit abort")))) > ((princ (strcat "\nError: " Msg))) > ) > (setvar "osmode" osm) > (setvar "cmdecho" 1) > (princ) > ) ;end > > (defun MidPoint (p1 p2) > (mapcar '* (mapcar '+ p1 p2) '(0.5 0.5 0.5)) > ) ;end > > (setq doc (vla-get-activedocument (vlax-get-acad-object))) > (setq osm (getvar "osmode")) > (setvar "osmode" 0) > (setvar "cmdecho" 0) > > (while > (setq pt (getpoint "\nPick point inside intersection: ")) > (vla-StartUndoMark doc) > (command "-boundary" pt "") > (setq tempobj (vlax-ename->vla-object (entlast))) > (setq coord (vlax-get tempobj 'Coordinates)) > (vla-delete tempobj) > (repeat 4 > (setq ptlst (cons (list (car coord) (cadr coord)) ptlst)) > (setq coord (cddr coord)) > ) > (setq ptlst (mapcar '(lambda (x) (trans x 0 1)) ptlst)) > (setq p1 (MidPoint (car ptlst) (cadr ptlst))) > (setq p2 (MidPoint (cadr ptlst) (caddr ptlst))) > (setq p3 (MidPoint (caddr ptlst) (last ptlst))) > (setq p4 (MidPoint (car ptlst) (last ptlst))) > (setq zmpt1 (polar pt 0.0 (* (distance p1 p3) 5))) > (setq zmpt2 (polar pt pi (* (distance p1 p3) 5))) > (command "zoom" "w" zmpt1 zmpt2) > (command "_break" p1 "F" (car ptlst) (cadr ptlst) > "_break" p2 "F" (cadr ptlst) (caddr ptlst) > "_break" p3 "F" (caddr ptlst) (last ptlst) > "_break" p4 "F" (car ptlst) (last ptlst)) > (command "zoom" "p") > (vla-EndUndoMark doc) > (setq ptlst nil) > ) ;while > (*Error* nil) > (princ) > ) ;end > > > > Hi, > > > > Does anyone have a LISP or Script that will clean up intersections? Both linear and > radius intersections. I have been constantly trimming and after a few hundred > thousand clicks, I figure there has to be an easier way. I've also have tried using > BPOLY command but it creates polylines on top of existing lines, which I then have to > delete. I am just learning LISP so I'm not sure how to conquer this problem. > > > > I have attached a .BMP file which shows exactly what I'm looking for. > > > > I run Vanilla ACAD 2002 > > > > Any help will be greatly appreciated > > > > Gary > >
*Joe Burke
Message 10 of 21 (140 Views)

Re: LISP for intersection clean up

07-14-2004 09:19 AM in reply to: zorroxxxx
GaryDF, My pleasure. Please keep in mind, what I posted is only intended to demonstrate the one-click idea. It should be reliable when lines are involved. Arcs are another matter. It may or may not work with arcs depending on whether the midpoint returned allows an arc to be selected within the break commands. Regards Joe Burke > Joe, > > Excellent routines....thanks for sharing it. > > Gary [_]P

You are not logged in.

Log into access your profile, ask and answer questions, share ideas and more. Haven't signed up yet? Register

Announcements
Are you familiar with the Autodesk Expert Elites? The Expert Elite program is made up of customers that help other customers by sharing knowledge and exemplifying an engaging style of collaboration. To learn more, please visit our Expert Elite website.

Need installation help?

Start with some of our most frequented solutions to get help installing your software.

Ask the Community