Visual LISP, AutoLISP and General Customization
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

LISP for intersection clean up

20 REPLIES 20
Reply
Message 1 of 21
zorroxxxx
1609 Views, 20 Replies

LISP for intersection clean up

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
20 REPLIES 20
Message 2 of 21
EC-CAD
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
Message 3 of 21
Anonymous
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
Message 4 of 21
aewatson
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
Message 5 of 21
Anonymous
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
Message 6 of 21
Anonymous
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:DRWC (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
Message 7 of 21
Anonymous
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
Message 8 of 21
zorroxxxx
in reply to: zorroxxxx

Problem solved.

Thanks to all who posted.

Gary
Message 9 of 21
Anonymous
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 > >
Message 10 of 21
Anonymous
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
Message 11 of 21
Anonymous
in reply to: zorroxxxx

I was looking at your code and fixed (I think!) the arc problem: (defun C:CI () (c:CleanIntersections)) (defun c:CleanIntersections ( / *Error* doc osm pkbx pt tempobj coord ptlist 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 b p2 / p b) (setq p (mapcar '* (mapcar '+ p1 p2) '(0.5 0.5 0.5))) ; midpoint of projection (setq d (/ (* b (distance p1 p2)) 2)) ; bulge distance (setq p (polar p (+ (angle p1 p2) (dtr -90)) d)) ; actual midpoint considering bulge factor (print p) ) ;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 ent (entget (entlast))) ;(setq tempobj (vlax-ename->vla-object (entlast))) ;(setq coord (print (vlax-get tempobj 'Coordinates))) (setq ptlist (massoc 10 (entget (entlast)))) (setq blglst (massoc 42 (entget (entlast)))) ;(repeat 4 ; (setq ptlist (cons (list (car coord) (cadr coord)) ptlist)) ; (setq coord (cddr coord)) ;) ;(vla-delete tempobj) (entdel (entlast)) (setq ptlist (mapcar '(lambda (x) (trans x 0 1)) ptlist)) (setq p1 (MidPoint (car ptlist) (car blglst) (cadr ptlist))) (setq p2 (MidPoint (cadr ptlist) (cadr blglst) (caddr ptlist))) (setq p3 (MidPoint (caddr ptlist) (caddr blglst) (last ptlist))) (setq p4 (MidPoint (car ptlist) (car blglst) (last ptlist))) (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 ptlist) (cadr ptlist) "_break" p2 "F" (cadr ptlist) (caddr ptlist) "_break" p3 "F" (caddr ptlist) (last ptlist) "_break" p4 "F" (car ptlist) (last ptlist) ) (command "zoom" "p") (vla-EndUndoMark doc) (setq ptlist nil) ) ;while (*Error* nil) (princ) ) ;end (defun massoc(key inlist / outlist) (foreach element inlist (if (= (car element) key) (setq outlist (cons (cdr element) outlist)) ) ) (reverse outlist) )
Message 12 of 21
Anonymous
in reply to: zorroxxxx

Forgot that the (dtr) function isn't included: (defun DTR (a) ;Degrees to radians conversion (* pi (/ a 180.0))) (defun RTD (a) ;Radians to degrees conversion (* 180.0 (/ a pi)))
Message 13 of 21
Anonymous
in reply to: zorroxxxx

Good this got ride of the AutoCAD error...which locked up the drawing sometimes. On another note, how would you mode the code to do a tee intersction and a corner intersection? Gary "Allen Johnson" wrote in message news:40f561ea$1_2@newsprd01... > Forgot that the (dtr) function isn't included: > > (defun DTR (a) ;Degrees to radians conversion > (* pi (/ a 180.0))) > > (defun RTD (a) ;Radians to degrees conversion > (* 180.0 (/ a pi))) > >
Message 14 of 21
Anonymous
in reply to: zorroxxxx

Allen, I haven't tried your modified code. It looks like a good idea to deal with arcs. BTW, when I wrote the one-click thing I thought it wouldn't work with arcs. The fact it did in most cases given Gary's examples was an unexpected bonus. Thanks Joe Burke
Message 15 of 21
Anonymous
in reply to: zorroxxxx

Nice Joe, It did however crash autocad under certain situations, specifically, when the intersection picked was not entirely closed (boundary failure leads to activeX failure when entlast is not a polyline). Crash occurs sometimes after undoing the operation. Suggest adding a check to see if the last entity is a new polyline entity. Regards, Doug "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 > >
Message 16 of 21
Anonymous
in reply to: zorroxxxx

GaryDF, I think if you want discrete intersection clean-up, consider some of the other code posted here which requires selecting objects. I wrote a function which does tee intersections. It extends or trims the first two lines selected to a third line which is broken in the process to create the desired effect. I doubt this sort of thing can be done with one click since there are many possibilities involved. Of course I might be wrong. Luis Esquivel has posted some functions which deal with these issues. Sorry, I don't recall what they were called. Maybe Luis will read this and let us know. Joe Burke > Good this got ride of the AutoCAD error...which locked up the drawing sometimes. > On another note, how would you mode the code to do a tee intersction and a > corner intersection? > > Gary
Message 17 of 21
Anonymous
in reply to: zorroxxxx

Hi Doug, Checking for boundary pline created was at the top of my list of things to do. As I said, "needs more error checking." I didn't suspect the lack of such would cause a fatal error which crashes the application. Oh bother! I was only trying to demonstrate an alternate method... Thanks for the heads-up. Joe > Nice Joe, > > It did however crash autocad under certain situations, > specifically, when the intersection picked was not entirely > closed (boundary failure leads to activeX failure when entlast > is not a polyline). Crash occurs sometimes > after undoing the operation. > > Suggest adding a check to see if the last entity is a new > polyline entity. > > Regards, > Doug
Message 18 of 21
Anonymous
in reply to: zorroxxxx

Hi Joe! Sorry but don't remember too... :-( Your routine works great... just some touch-up's and rock & roll I have posted here a fas routine, that does the same but does not work for arc's... it is for cross, tee and corner clean up, user requires to select by window the crossing line that needs to be out... if i found the open code i will post that here... but is a very oooold lispy. Luis. > I think if you want discrete intersection clean-up, consider some of the other code > posted here which requires selecting objects. > > I wrote a function which does tee intersections. It extends or trims the first two > lines selected to a third line which is broken in the process to create the desired > effect. I doubt this sort of thing can be done with one click since there are many > possibilities involved. > > Of course I might be wrong. Luis Esquivel has posted some functions which deal with > these issues. Sorry, I don't recall what they were called. Maybe Luis will read this > and let us know. > > Joe Burke
Message 19 of 21
Anonymous
in reply to: zorroxxxx

Hi Luis, I searched two machines for your old wall intersection functions. I know I had them at some point, but I can't find them now. I'm pretty sure they were open code since I think I recall looking at how you did it. Oh well... Right, it was old stuff. Which at this point, maybe you'd rather not have dredged up anyway. ;-) Good to see you here again. Regards Joe Burke "Luis Esquivel" wrote in message news:40f697e1$1_3@newsprd01... > Hi Joe! > > Sorry but don't remember too... :-( > > Your routine works great... just some touch-up's and rock & roll > > I have posted here a fas routine, that does the same but does not work for > arc's... it is for cross, tee and corner clean up, user requires to select > by window the crossing line that needs to be out... if i found the open > code i will post that here... but is a very oooold lispy. > > Luis. > > > I think if you want discrete intersection clean-up, consider some of the > other code > > posted here which requires selecting objects. > > > > I wrote a function which does tee intersections. It extends or trims the > first two > > lines selected to a third line which is broken in the process to create > the desired > > effect. I doubt this sort of thing can be done with one click since there > are many > > possibilities involved. > > > > Of course I might be wrong. Luis Esquivel has posted some functions which > deal with > > these issues. Sorry, I don't recall what they were called. Maybe Luis will > read this > > and let us know. > > > > Joe Burke > >
Message 20 of 21
kozmos
in reply to: zorroxxxx

as for processing crossed lines, you can try kozmos Cross2004, a very intellegent routine to trim the crossed corners.
download at http://www.ikozmos.com

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Autodesk Design & Make Report

”Boost