To Find Self Intersection of LWPOLYLINE
Here’s a C++ version for AutoCAD 2025 if you want to compare performance
https://www.theswamp.org/index.php?topic=59892.0
takes about 4 seconds to chomp though 800 or so of the mill_pl sample (altered the green so it’s not overlapping)
A new python version here
https://www.theswamp.org/index.php?topic=59870.msg622866#msg622866
python takes 20 seconds for the same test. Python is almost as fast on a per case bases, but there’s a thread lock which is a bummer
I am sorry to bother you again, but it seems that my latest version fails to find intersection at example shown at picture...
So, to make it work in all situations, I am afraid that it must be much slower... Here is my latest code that passes this final test, but unfortunately it is very much slow... I don't know if Dan has something new, but like I said if striving for speed, then Python or ObjectARX, or .NET could be an answer... If you have BricsCAD, then maybe, this my code could be all that is needed...
(defun c:self-inters-overls ( / *error* unique isoobjs unisoobjs *lst* vertlst selfintlst ent cad vl obj1 el ss i e obj2 sl lst )
(or
(not
(vl-catch-all-error-p
(vl-catch-all-apply
(function vlax-get-acad-object) nil
)
)
)
(vl-load-com)
)
(defun *error* ( m )
(if (and m (wcmatch (strcase m) "*EXIT*"))
(princ)
(if m
(progn
(prompt m)
(princ)
)
(if lst
(progn
(prompt "\nSelf-intersecting-overlapping points in WCS are : ")
(prompt "\n")
(read (vl-princ-to-string (unique lst 1e-6)))
)
(princ)
)
)
)
)
(defun unique ( lst fuzz / a ll )
(while (setq a (car lst))
(if (vl-some (function (lambda ( x ) (equal x a fuzz))) (cdr lst))
(setq ll (cons a ll) lst (vl-remove-if (function (lambda ( x ) (equal x a fuzz))) (cdr lst)))
(setq ll (cons a ll) lst (cdr lst))
)
)
(reverse ll)
)
(defun isoobjs ( s / ss i e enx )
(setq ss (ssget "_X"))
(repeat (setq i (sslength ss))
(setq e (ssname ss (setq i (1- i))))
(if (and (not (ssmemb e s)) (not (vl-position (cons 60 1) (setq enx (entget e)))))
(progn
(entupd (cdr (assoc -1 (entmod (append enx (list (cons 60 1)))))))
(setq *lst* (cons e *lst*))
)
)
)
)
(defun unisoobjs nil
(if *lst*
(foreach e *lst*
(entupd (cdr (assoc -1 (entmod (subst (cons 60 0) (cons 60 1) (entget e))))))
)
)
)
(defun vertlst ( obj / e ent enx lst )
(if (= (type obj) (quote vla-object))
(setq ent (vlax-vla-object->ename obj))
(setq ent obj)
)
(setq e ent)
(cond
( (= (cdr (assoc 0 (setq enx (entget ent)))) "LWPOLYLINE")
(mapcar
(function
(lambda ( p )
(trans
(append
(mapcar (function +) (list 0.0 0.0) p)
(list (cdr (assoc 38 enx)))
)
e
0
)
)
)
(mapcar (function cdr)
(vl-remove-if
(function
(lambda ( x )
(/= (car x) 10)
)
)
enx
)
)
)
)
( (and (= (cdr (assoc 0 enx)) "POLYLINE") (or (= 8 (cdr (assoc 70 enx))) (= 9 (cdr (assoc 70 enx)))))
(while (setq ent (entnext ent))
(if (= (cdr (assoc 0 (setq enx (entget ent)))) "VERTEX")
(setq lst
(cons
(cdr (assoc 10 enx))
lst
)
)
)
)
(reverse lst)
)
( (= (cdr (assoc 0 enx)) "POLYLINE")
(while (setq ent (entnext ent))
(if (= (cdr (assoc 0 (setq enx (entget ent)))) "VERTEX")
(setq lst
(cons
(cdr (assoc 10 enx))
lst
)
)
)
)
(mapcar
(function
(lambda ( p )
(trans p e 0)
)
)
(reverse lst)
)
)
)
)
(defun selfintlst ( obj1 obj2 / lst rtn )
(setq lst
(vlax-invoke
(if (= (type obj1) (quote ename))
(vlax-ename->vla-object obj1)
obj1
)
(quote intersectwith)
(if (= (type obj2) (quote ename))
(vlax-ename->vla-object obj2)
obj2
)
acextendnone
)
)
(repeat (/ (length lst) 3)
(setq rtn
(cons
(list (car lst) (cadr lst) (caddr lst))
rtn
)
)
(setq lst (cdddr lst))
)
(reverse rtn)
)
(if
(and
(setq ent (car (entsel "\nPick POLYLINE entity to get its self-intersecting-overlapping points...")))
(wcmatch (cdr (assoc 0 (entget ent))) "*POLYLINE")
)
(if
(not
(vl-catch-all-error-p
(vl-catch-all-apply
(function vlax-curve-getstartpoint)
(list ent)
)
)
)
(progn
(isoobjs (ssadd ent))
(vla-zoomextents (setq cad (vlax-get-acad-object)))
(setq vl (vertlst ent))
(setq obj1 (vlax-ename->vla-object ent))
(setq el (entlast))
(vla-explode obj1)
(foreach v vl
(if (setq ss (ssget "_C" (trans v 0 1) (trans v 0 1)))
(repeat (setq i (sslength ss))
(setq e (ssname ss (setq i (1- i))))
(if (= (cdr (assoc 0 (entget e))) "VERTEX")
(ssdel e ss)
)
)
)
(if (and ss (> (sslength ss) 3))
(setq lst (cons v lst))
)
)
(while (wcmatch (cdr (assoc 0 (entget (entnext el)))) "VERTEX,SEQEND")
(setq el (entnext el))
)
(while (setq el (entnext el))
(setq obj2 (vlax-ename->vla-object el))
(setq sl (vl-catch-all-apply (function selfintlst) (list obj1 obj2)))
(if (and sl (not (vl-catch-all-error-p sl)))
(progn
(setq sl (vl-remove-if (function (lambda ( x ) (equal x (vlax-curve-getstartpoint el) 1e-6))) sl)
sl (vl-remove-if (function (lambda ( x ) (equal x (vlax-curve-getendpoint el) 1e-6))) sl)
)
(if sl
(setq lst (append sl lst))
)
(setq sl nil)
)
)
(vl-catch-all-apply (function vla-delete) (list obj2))
(vlax-release-object obj2)
)
(if (and ent (vlax-erased-p ent))
(entdel ent)
)
(vla-zoomprevious cad)
(unisoobjs)
)
(progn
(prompt "\nInvalid entity pick... Picked entity must be POLYLINE... Better luck next time...")
(exit)
)
)
(prompt "\nMissed or Invalid entity pick... Picked entity must be POLYLINE... Better luck next time...")
)
(*error* nil)
)
HTH.
Regards, M.R.
Yeah, it's working. But instead of two intersection points, it gives one. And it doesn't find overlaps.
Like the previous one, it checks for about 1 minute.
Why did you use Scale? And not Move?
Both this option and the previous ones for many cases of self-overlapping and touching do not give any messages.
I have attached an example with million coordinates earlier. I am attaching it here as well.
