Here's a LISP routine that checks for overlapping polylines.
It does not correct them, but shows you where they overlap.
Be SURE you create a layer with a vey distinctive color and have that layer active before you start the routine.
The routine will create a region on this layer showing you where the overlap is.
You would then correct the overlap and then delete the region.
I use this on a daily basis.....Worth a try !!!
;| PolylineOverlap.lsp
Determines whether two polylines in the same plane overlap
by turning copies of both into regions and subtracting one
from the other to see if its area changes.
If so, creates a region showing the overlap and zooms in on it.
Works with either heavy or LW polylines, and checks that they are closed
and co-planar. Aborts if either polyline is self-intersecting.
by Bill Gilliss
bill at realerthanreal dot com
Comments and suggestions always welcome.
No warranty, either expressed or implied, is made as to the fitness of
this information for any particular purpose. All materials are to be
considered 'as-is' and use thereof should be considered as at your own
risk.
v 1.0 2010-03-01 - initial release in response to newsgroup request
======================================================================
|;
(defun c:polyOverlap ( / e1 en1 ed1 obj1 area1 elev1 extr1
e2 en2 ed2 obj2 area2 elev2 extr2
area3 olderror *delobj obj
reg1 reg1b reg1c reg1d reg1created
reg2 reg2b reg2c reg2d reg2created
getPoly1 getPoly2 makeReg1 makeReg2 findOverlap
)
;;============== SUBROUTINES =========================
(defun myerror (msg)
(princ msg)
(if reg1created (command "._erase" reg1 ""))
(setvar 'delobj *delobj)
(setvar 'cmdecho *cmdecho)
(setq *error* olderror)
)
;;====================================
(defun getPoly1 ()
(setq en1 nil)
(while
(not en1)
(prompt "Select first polyline: ")
(setq ss (ssget ":S" '(( 0 . "POLYLINE,LWPOLYLINE"))))
(if ss (setq en1 (ssname ss 0)))
)
(setq ed1 (entget en1))
(if (/= 1 (logand (cdr (assoc 70 ed1)) 1))
(progn
(vlr-beep-reaction)
(princ "Polyline is not closed.")
(quit)
)
)
(if (= (cdr (assoc 0 ed1)) "POLYLINE")
(setq elev1 (caddr (cdr (assoc 10 ed1)))) ;; heavy polyline
(setq elev1 (cdr (assoc 38 ed1))) ;; LWPolyline
)
(setq extr1 (cdr (assoc 210 ed1)))
)
;;====================================
(defun makeReg1 ()
(setq prevEnt (entlast))
(command "region" en1 "")
(setq newEnt (entlast))
(if (not (equal prevEnt newEnt)) ;;verify region created successfuly
(progn
(setq reg1 (entlast))
(setq reg1Created T)
)
(progn
(princ "Problem with polyline - self-intersecting?\n")
(vlr-beep-reaction)
(quit)
)
)
(setq ed1 (entget reg1))
(setq area1 (vlax-get-property (vlax-ename->vla-object reg1) "Area"))
)
;;====================================
(defun getPoly2 ()
(setq en2 nil)
(while
(not en2)
(prompt "Select second polyline: ")
(setq ss (ssget ":S" '(( 0 . "POLYLINE,LWPOLYLINE"))))
(if ss (setq en2 (ssname ss 0)))
)
(setq ed2 (entget en2))
(if (/= 1 (logand (cdr (assoc 70 ed2)) 1))
(progn
(vlr-beep-reaction)
(princ "Polyline is not closed.")
(quit)
)
)
(if (= (cdr (assoc 0 ed2)) "POLYLINE")
(setq elev2 (caddr (cdr (assoc 10 ed2)))) ;; heavy polyline
(setq elev2 (cdr (assoc 38 ed2))) ;; LWPolyline
)
(setq extr2 (cdr (assoc 210 ed2)))
)
;;====================================
(defun makeReg2 ()
(setq prevEnt (entlast))
(command "region" en2 "")
(setq newEnt (entlast))
(if (not (equal prevEnt newEnt))
(progn
(setq reg2 (entlast))
)
(progn
(princ "Problem with polyline - self-intersecting?\n")
(vlr-beep-reaction)
(quit)
)
)
(setq ed2 (entget reg2))
(setq area2 (vlax-get-property (vlax-ename->vla-object reg2) "Area"))
)
;;====================================
(defun findOverlap ()
(entmake ed1)
(setq reg1b (entlast))
(entmake ed2)
(setq reg2b (entlast))
(command "._subtract" reg2b "" reg1b "")
(entmake ed1)
(setq reg1c (entlast))
(entmake ed2)
(setq reg2c (entlast))
(command "._subtract" reg1c "" reg2c "")
(entmake ed1)
(setq reg1d (entlast))
(entmake ed2)
(setq reg2d (entlast))
(command "._union" reg1d reg2d "")
(command "._union" reg2b reg1c "")
(command "._subtract" reg1d "" reg2b "") ;;region of intersection
(command "._change" reg1d "" "_prop" "_color" 6 "")
(princ "\nPolylines DO overlap.")
(setq overlapRegion (vlax-ename->vla-object reg1d))
(vlax-invoke-method overlapRegion "getboundingbox" 'minA 'maxA)
(setq LL (trans (vlax-safearray->list minA) 0 1) UR (trans (vlax-safearray->list maxA) 0 1))
(command "._zoom" "_Window" LL UR)
(command "._zoom" "0.25x")
)
;;============= MAIN PROGRAM ===========================
(setq olderror *error*)
(setq *error* myerror)
(setq *delobj (getvar 'delobj)) (setvar 'delobj 0)
(setq *cmdecho (getvar 'cmdecho)) (setvar 'cmdecho 0)
(vl-load-com)
(getPoly1)
(makeReg1)
(getPoly2)
(makeReg2)
(if (and (equal elev1 elev2) (equal extr1 extr2)) ;;co-planar
(progn
(command "._subtract" reg1 "" reg2 "")
(setq area3 (vlax-get-property (vlax-ename->vla-object reg1) "Area"))
(if (= area1 area3)
(progn
(princ "\n ----Polylines do NOT overlap -----")
(vlr-beep-reaction)
)
(findOverlap) ;; show overlap with new region
)
)
(progn
(vlr-beep-reaction)
(princ "Polylines are not at same elevation or in same UCS.")
(quit)
)
)
(if reg1created (command "erase" reg1 ""))
(setvar 'delobj *delobj)
(setvar 'cmdecho *cmdecho)
(setq *error* olderror)
(princ)
);; end polyOverlap
(princ "POLYOVERLAP loaded.")
(princ)