Auto-suggest helps you quickly narrow down your search results by suggesting possible matches as you type.

Close

Visual LISP, AutoLISP and General Customization

- Autodesk Community
- >
- AutoCAD Customization
- >
- Visual LISP, AutoLISP and General Customization
- >
- LISP for intersection clean up

Topic Options

- Subscribe to RSS Feed
- Mark Topic as New
- Mark Topic as Read
- Float this Topic to the Top
- Bookmark
- Subscribe
- Printer Friendly Page

- Mark as New
- Bookmark
- Subscribe
- Subscribe to RSS Feed
- Highlight
- Email to a Friend
- Report Inappropriate Content

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

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

- Mark as New
- Bookmark
- Subscribe
- Subscribe to RSS Feed
- Highlight
- Email to a Friend
- Report Inappropriate Content

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

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

- Mark as New
- Bookmark
- Subscribe
- Subscribe to RSS Feed
- Highlight
- Email to a Friend
- Report Inappropriate Content

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

- Mark as New
- Bookmark
- Subscribe
- Subscribe to RSS Feed
- Highlight
- Email to a Friend
- Report Inappropriate Content

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

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

- Mark as New
- Bookmark
- Subscribe
- Subscribe to RSS Feed
- Highlight
- Email to a Friend
- Report Inappropriate Content

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

- Mark as New
- Bookmark
- Subscribe
- Subscribe to RSS Feed
- Highlight
- Email to a Friend
- Report Inappropriate Content

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 ARCHRWC (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

- Mark as New
- Bookmark
- Subscribe
- Subscribe to RSS Feed
- Highlight
- Email to a Friend
- Report Inappropriate Content

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

- Mark as New
- Bookmark
- Subscribe
- Subscribe to RSS Feed
- Highlight
- Email to a Friend
- Report Inappropriate Content

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

Problem solved.

Thanks to all who posted.

Gary

Thanks to all who posted.

Gary

- Mark as New
- Bookmark
- Subscribe
- Subscribe to RSS Feed
- Highlight
- Email to a Friend
- Report Inappropriate Content

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
>
>

- Mark as New
- Bookmark
- Subscribe
- Subscribe to RSS Feed
- Highlight
- Email to a Friend
- Report Inappropriate Content

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

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

Announcements

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

Upgrading to a 2015 product? Make sure to check these out 1st!

- Privacy | Legal Notices & Trademarks | Report Noncompliance | Site map | © Copyright 2014 Autodesk Inc. All rights reserved

Except where otherwise noted, this work is licensed under a Creative Commons Attribution-NonCommercial-ShareAlike 3.0 Unported License. Please see the Autodesk Creative Commons FAQ for more information.