To Find Self Intersection of LWPOLYLINE

[MehtaRajesh]

Hi,

I am posting useful function to find Self Intersection for selected LWPOLYLINE.
You might be having other options, but I find this one as a quickest and Simple


(defun IsSelfIntersect (l / vcnt vcnt1 crossresult pt1 pt2 pt3 pt4)
(setq vcnt 0)
(setq crossresult F)
(repeat (1- (length l))
 (setq pt1 (nth vcnt l))
   (setq pt2 (nth (1+ vcnt) l))
   (setq vcnt1 vcnt)
 (setq isdone "T")
 (while isdone
  (if (and (nth (+ 2 vcnt) l) (nth (+ 3 vcnt) l))
  (progn
   (setq pt3 (nth (+ 2 vcnt) l))
   (setq pt4 (nth (+ 3 vcnt) l))
       (if (inters pt1 pt2 pt3 pt4)
   (progn
      (setq crossresult T)
   );progn
   );if
  );progn
  (progn
   (setq isdone nil)
  );progn
  );if
    (setq vcnt (1+ vcnt))
 );while
   (setq vcnt (1+ vcnt1)) 
);repeat
crossresult
);defun

Below Function to get the Coordinate list of LWPOLYLINE

(defun lwptslw (lst / pair rtn)
  (while (setq pair (assoc 10 lst))
    (setq rtn (cons (cdr pair) rtn)
   lst (cdr (member pair lst))
    )
  )
  (reverse rtn)
)

USAGE:
Command: (IsSelfIntersect (LWPTSLW (ENTGET (CAR (ENTSEL "\nSelect Lwpolyline to find Self Intersectioni")))))

Regards,
Rajesh

[marko_ribar]

@АлексЮстасу 

I've implemented move as you suggested and I think that now it's better (look at my previous post where I ammended the code)... Still it gave me somewhat wrong results - it founded 1412 points on your bigger example with over 4000 vertices polyline... From those 1412 points one was correctly founded (lower one from zig-zag stretched segment) as self-intersectioned one and the other (also obvious one - upper one) was not founded - intersectwith failed to detect it... I am thinking that this failure has something with my removing zooming like it was previously coded... Still not sure, but here is my version with scale, move and zoomings... I am out of thinking for now, but I am afraid that it has to be slooow...

(defun c:self-inters-overls-millions ( / *error* unique isoobjs unisoobjs *lst1* *lst2* selfintlst cmd ape ucsf ent cad obj1 el ss i e obj2 ellst ell sl lst sp ti )

  (or
    (not
      (vl-catch-all-error-p
        (vl-catch-all-apply
          (function vlax-get-acad-object) nil
        )
      )
    )
    (vl-load-com)
  )

  (defun *error* ( m )
    (if ucsf
      (if command-s
        (command-s "_.ucs" "_p")
        (vl-cmdf "_.ucs" "_p")
      )
    )
    (if ape
      (setvar (quote aperture) ape)
    )
    (if cmd
      (setvar (quote cmdecho) cmd)
    )
    (if (and m (wcmatch (strcase m) "*EXIT*"))
      (princ)
      (progn
        (prompt "\nElapsed time : ") (princ (rtos (- (car (_vl-times)) ti) 2 16)) (prompt " milliseconds...")
        (if m
          (progn
            (if lst
              (progn
                (prompt "\nSelf-intersecting-overlapping points in WCS are : ")
                (prompt "\n")
                (setq lst (mapcar (function (lambda ( x ) (mapcar (function +) sp x))) (unique lst 1e-6)))
                (setq lst (mapcar (function (lambda ( x ) (mapcar (function (lambda ( y ) (* y 1e+6))) x))) lst))
                (read (vl-princ-to-string lst))
              )
            )
            (prompt m)
            (princ)
          )
          (if lst
            (progn
              (prompt "\nSelf-intersecting-overlapping points in WCS are : ")
              (prompt "\n")
              (setq lst (mapcar (function (lambda ( x ) (mapcar (function +) sp x))) (unique lst 1e-6)))
              (setq lst (mapcar (function (lambda ( x ) (mapcar (function (lambda ( y ) (* y 1e+6))) x))) lst))
              (read (vl-princ-to-string lst))
            )
            (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 rtn )
    (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 rtn (cons e rtn))
        )
      )
    )
    rtn
  )

  (defun unisoobjs ( *lst* )
    (if *lst*
      (foreach e *lst*
        (entupd (cdr (assoc -1 (entmod (subst (cons 60 0) (cons 60 1) (entget e))))))
      )
    )
  )

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

  (setq cmd (getvar (quote cmdecho)))
  (setvar (quote cmdecho) 0)
  (setq ape (getvar (quote aperture)))
  (setvar (quote aperture) 1)
  (if (= 0 (getvar (quote worlducs)))
    (progn
      (vl-cmdf "_.ucs" "_w")
      (setq ucsf t)
    )
  )
  (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
        (setq ti (car (_vl-times)))
        (vl-cmdf "_.scale" ent "" "_non" (list 0.0 0.0 0.0) 1e-6)
        (vl-cmdf "_.move" ent "" "_non" (setq sp (vlax-curve-getstartpoint ent)) "_non" (list 0.0 0.0 0.0))
        (setq *lst1* (isoobjs (ssadd ent)))
        (vla-zoomextents (setq cad (vlax-get-acad-object)))
        (setq obj1 (vlax-ename->vla-object ent))
        (setq el (entlast))
        (vla-explode obj1)
        (while (wcmatch (cdr (assoc 0 (entget (entnext el)))) "VERTEX,SEQEND")
          (setq el (entnext el))
        )
        (while (setq el (entnext el))
          (setq *lst2* (isoobjs (ssadd el)))
          (vla-zoomextents cad)
          (unisoobjs *lst2*)
          (setq *lst2* nil)
          (if (setq ss (ssget "_C" (trans (vlax-curve-getstartpoint el) 0 1) (trans (vlax-curve-getstartpoint el) 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 (not (eq e (vlax-vla-object->ename obj1)))
                  (setq ell (cons e ell))
                )
              )
            )
          )
          (if
            (and
              ss
              (or
                (> (sslength ss) 3)
                (and
                  (= (sslength ss) 3)
                  (vl-some
                    (function
                      (lambda ( x )
                        (and
                          (not (equal (vlax-curve-getstartpoint x) (vlax-curve-getstartpoint el) 1e-6))
                          (not (equal (vlax-curve-getendpoint x) (vlax-curve-getstartpoint el) 1e-6))
                        )
                      )
                    )
                    ell
                  )
                )
              )
            )
            (setq lst (cons (vlax-curve-getstartpoint el) lst))
          )
          (setq ell nil)
          (if (setq ss (ssget "_C" (trans (vlax-curve-getendpoint el) 0 1) (trans (vlax-curve-getendpoint el) 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 (not (eq e (vlax-vla-object->ename obj1)))
                  (setq ell (cons e ell))
                )
              )
            )
          )
          (if
            (and
              ss
              (or
                (> (sslength ss) 3)
                (and
                  (= (sslength ss) 3)
                  (vl-some
                    (function
                      (lambda ( x )
                        (and
                          (not (equal (vlax-curve-getstartpoint x) (vlax-curve-getendpoint el) 1e-6))
                          (not (equal (vlax-curve-getendpoint x) (vlax-curve-getendpoint el) 1e-6))
                        )
                      )
                    )
                    ell
                  )
                )
              )
            )
            (setq lst (cons (vlax-curve-getendpoint el) lst))
          )
          (setq ell nil)
          (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)
            )
          )
          (setq ellst (cons el ellst))
          (vla-zoomprevious cad)
        )
        (foreach el ellst
          (if (and el (not (vlax-erased-p el)))
            (entdel el)
          )
        )
        (vla-zoomprevious cad)
        (vl-cmdf "_.move" ent "" "_non" (list 0.0 0.0 0.0) "_non" sp)
        (vl-cmdf "_.scale" ent "" "_non" (list 0.0 0.0 0.0) 1e+6)
        (unisoobjs *lst1*)
      )
      (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)
)

Now it's not HTH. as there is nothing for hope this helps...

Regards, M.R.

[АлексЮстасу]

@marko_ribar,

A small polygon with no self-intersections or self overlaps started flying all over the screen. And the entire command window was taken up with messages about model regeneration.
For the large polygon, I interrupted the execution after a few minutes.
I think some wrong path has been chosen now. Basically.
It doesn't look like this is the way to get the speed and accuracy of the results right...
But they say “a negative result is also a result”.

[marko_ribar]

Pick POLYLINE entity to get its self-intersecting-overlapping points...
Elapsed time : 3106062 milliseconds...
Self-intersecting-overlapping points in WCS are :
((7652990.31514978 6229574.36978839 -148.985) (7653227.14034957 6229000.69033948 -148.985) (7652899.72908173 6229793.80321712 -148.985) (7653288.08727723 6229052.95231795 -148.985))

;|
(entmake (list (cons 0 "POINT") (list 10 7652990.31514978 6229574.36978839 -148.985)))
(entmake (list (cons 0 "POINT") (list 10 7653227.14034957 6229000.69033948 -148.985)))
(entmake (list (cons 0 "POINT") (list 10 7652899.72908173 6229793.80321712 -148.985)))
(entmake (list (cons 0 "POINT") (list 10 7653288.08727723 6229052.95231795 -148.985)))
|;

Hi, @АлексЮстасу 
I've let my last version to finish calculation on your bigger example - had to wait something over 50 minutes... It founded 4 points from which 2 are start/end points, third point is overlapping one and 4th one is self-intersecting one... Still one self-intersecting point was missed...
I'll attach your DWG for you to see what it founded and what not... To be honest, I can't find the reason why 2nd self-intersecting point routine missed...
So, like I thought, that quick routine my previous one - not last, but one before (without zoomings) founded bunch of points that aren't self-intersecting-overlapping - it's because of (ssget "_C" pt pt) and because your polyline is with so dense points that when whole poyline was zoomed extents it still picks more entities than it should - I am guessing 4, or 3 lines and original polyline which then make condition T for putting reference point in main point lst [ (> (sslength ss) 3) ]...
I have to leave all things for later examination, but like I thought - what is fast that is also unreliable (1412 points instead of just 4)...
That's all from me...
Regards, M.R.

[АлексЮстасу]

I came across one of these from .Net:

/// <summary>
/// The polyline intersects itself
/// </summary>
/// <param name="poly"></param>
/// <returns></returns>
public static bool PolylineIsSelfIntersecting(Polyline poly)
{
Curve3d curve3D = poly.GetGeCurve();
CurveCurveIntersector3d intersector = new CurveCurveIntersector3d(curve3D, curve3D, Vector3d.ZAxis);

return intersector.NumberOfIntersectionPoints > 0;
}

Is there a lisp analog to this or can it be applied somehow via lisp?

[marko_ribar]

@АлексЮстасу 

To make it more clear, I am guessing that to make LISP avoid false positive points like it throwed from last inspection your polyline (start/end vertex), I think that you shouldn't make zoom extents segments, but zoom window with just small tolerances around start/end vertices... (your last closing segment is drastically bigger than start/end segments, so when doing (ssget "_C" pt pt) I think that when zoom extents last closing segment, I think it selected both start and next segment (making false positive condition [ (> (sslength ss) 3) ]); this is also for ending point...) Here is my revised code, but notice that it works even more slower... It's not about making routine works fastest as possible, but making it works correct... (On normal polylines I am guessing that polylines should have at most 500 vertices - I'd apply @Kent1Cooper pldiet.lsp before starting this routine...)

(defun c:self-inters-overls-millions ( / *error* unique isoobjs unisoobjs *lst* selfintlst ape cmd ucsf ent cad obj1 el ss i e obj2 ellst ell sl lst sp ti )

  (or
    (not
      (vl-catch-all-error-p
        (vl-catch-all-apply
          (function vlax-get-acad-object) nil
        )
      )
    )
    (vl-load-com)
  )

  (defun *error* ( m )
    (if ucsf
      (if command-s
        (command-s "_.ucs" "_p")
        (vl-cmdf "_.ucs" "_p")
      )
    )
    (if ape
      (setvar (quote aperture) ape)
    )
    (if cmd
      (setvar (quote cmdecho) cmd)
    )
    (if (and m (wcmatch (strcase m) "*EXIT*"))
      (princ)
      (progn
        (if ti
          (progn
            (prompt "\nElapsed time : ") (princ (rtos (- (car (_vl-times)) ti) 2 16)) (prompt " milliseconds...")
          )
        )
        (if m
          (progn
            (if lst
              (progn
                (prompt "\nSelf-intersecting-overlapping points in WCS are : ")
                (prompt "\n")
                (setq lst (mapcar (function (lambda ( x ) (mapcar (function +) sp x))) lst))
                (setq lst (mapcar (function (lambda ( x ) (mapcar (function (lambda ( y ) (* y 1e+6))) x))) (unique lst 1e-12)))
                (read (vl-princ-to-string lst))
              )
            )
            (prompt m)
            (princ)
          )
          (if lst
            (progn
              (prompt "\nSelf-intersecting-overlapping points in WCS are : ")
              (prompt "\n")
              (setq lst (mapcar (function (lambda ( x ) (mapcar (function +) sp x))) lst))
              (setq lst (mapcar (function (lambda ( x ) (mapcar (function (lambda ( y ) (* y 1e+6))) x))) (unique lst 1e-12)))
              (read (vl-princ-to-string lst))
            )
            (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 rtn )
    (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 rtn (cons e rtn))
        )
      )
    )
    rtn
  )

  (defun unisoobjs ( *lst* )
    (if *lst*
      (foreach e *lst*
        (entupd (cdr (assoc -1 (entmod (subst (cons 60 0) (cons 60 1) (entget e))))))
      )
    )
  )

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

  (setq cmd (getvar (quote cmdecho)))
  (setvar (quote cmdecho) 0)
  (setq ape (getvar (quote aperture)))
  (setvar (quote aperture) 1)
  (if (= 0 (getvar (quote worlducs)))
    (progn
      (vl-cmdf "_.ucs" "_w")
      (setq ucsf t)
    )
  )
  (if (setq ent (car (entsel "\nPick POLYLINE entity to get its self-intersecting-overlapping points...")))
    (if (wcmatch (cdr (assoc 0 (entget ent))) "*POLYLINE")
      (progn
        (setq ti (car (_vl-times)))
        (vl-cmdf "_.scale" ent "" "_non" (list 0.0 0.0 0.0) 1e-6)
        (vl-cmdf "_.move" ent "" "_non" (setq sp (vlax-curve-getstartpoint ent)) "_non" (list 0.0 0.0 0.0))
        (setq *lst* (isoobjs (ssadd ent)))
        (vla-zoomextents (setq cad (vlax-get-acad-object)))
        (setq obj1 (vlax-ename->vla-object ent))
        (setq el (entlast))
        (vla-explode obj1)
        (while (wcmatch (cdr (assoc 0 (entget (entnext el)))) "VERTEX,SEQEND")
          (setq el (entnext el))
        )
        (while (setq el (entnext el))
          (vla-zoomwindow cad (vlax-3d-point (mapcar (function +) (list -1e-6 -1e-6 0.0) (vlax-curve-getstartpoint el))) (vlax-3d-point (mapcar (function +) (list 1e-6 1e-6 0.0) (vlax-curve-getstartpoint el))))
          (if (setq ss (ssget "_C" (trans (vlax-curve-getstartpoint el) 0 1) (trans (vlax-curve-getstartpoint el) 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 (not (eq e (vlax-vla-object->ename obj1)))
                  (setq ell (cons e ell))
                )
              )
            )
          )
          (if
            (and
              ss
              (or
                (> (sslength ss) 3)
                (and
                  (= (sslength ss) 3)
                  (vl-some
                    (function
                      (lambda ( x )
                        (and
                          (not (equal (vlax-curve-getstartpoint x) (vlax-curve-getstartpoint el) 1e-12))
                          (not (equal (vlax-curve-getendpoint x) (vlax-curve-getstartpoint el) 1e-12))
                        )
                      )
                    )
                    ell
                  )
                )
              )
            )
            (setq lst (cons (vlax-curve-getstartpoint el) lst))
          )
          (vla-zoomprevious cad)
          (setq ell nil)
          (vla-zoomwindow cad (vlax-3d-point (mapcar (function +) (list -1e-6 -1e-6 0.0) (vlax-curve-getendpoint el))) (vlax-3d-point (mapcar (function +) (list 1e-6 1e-6 0.0) (vlax-curve-getendpoint el))))
          (if (setq ss (ssget "_C" (trans (vlax-curve-getendpoint el) 0 1) (trans (vlax-curve-getendpoint el) 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 (not (eq e (vlax-vla-object->ename obj1)))
                  (setq ell (cons e ell))
                )
              )
            )
          )
          (if
            (and
              ss
              (or
                (> (sslength ss) 3)
                (and
                  (= (sslength ss) 3)
                  (vl-some
                    (function
                      (lambda ( x )
                        (and
                          (not (equal (vlax-curve-getstartpoint x) (vlax-curve-getendpoint el) 1e-12))
                          (not (equal (vlax-curve-getendpoint x) (vlax-curve-getendpoint el) 1e-12))
                        )
                      )
                    )
                    ell
                  )
                )
              )
            )
            (setq lst (cons (vlax-curve-getendpoint el) lst))
          )
          (vla-zoomprevious cad)
          (setq ell nil)
          (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-12))) sl)
                    sl (vl-remove-if (function (lambda ( x ) (equal x (vlax-curve-getendpoint el) 1e-12))) sl)
              )
              (if sl
                (setq lst (append sl lst))
              )
              (setq sl nil)
            )
          )
          (setq ellst (cons el ellst))
        )
        (foreach el ellst
          (if (and el (not (vlax-erased-p el)))
            (entdel el)
          )
        )
        (vla-zoomprevious cad)
        (vl-cmdf "_.move" ent "" "_non" (list 0.0 0.0 0.0) "_non" sp)
        (vl-cmdf "_.scale" ent "" "_non" (list 0.0 0.0 0.0) 1e+6)
        (unisoobjs *lst*)
      )
      (progn
        (prompt "\nInvalid entity pick... Picked entity must be POLYLINE... Better luck next time...")
        (exit)
      )
    )
    (progn
      (prompt "\nMissed... Better luck next time...")
      (exit)
    )
  )
  (*error* nil)
)

HTH.

M.R.

[marko_ribar]

Pick POLYLINE entity to get its self-intersecting-overlapping points...
Elapsed time : 23703 milliseconds...
Self-intersecting-overlapping points in WCS are :
((7652990.31514978 6229574.36978839 -148.985) (7653288.08727723 6229052.95231795 -148.985))

;|
(entmake (list (cons 0 "POINT") (list 10 7652990.31514978 6229574.36978839 -148.985)))
(entmake (list (cons 0 "POINT") (list 10 7653288.08727723 6229052.95231795 -148.985)))
|;

Here are my latest results on your simplified polyline that now has 1259 vertices... As you can see running lasted around 24 seconds... I used BricsCAD V25 on intel CORE I5 8GB RAM Laptop...
I'll attach your DWG with simplified polyline - I used Kent's PLDiet.lsp...

[daniel_cadext]

CurveCurveIntersector3d is the same thing I posted for Python here,

http://www.theswamp.org/index.php?topic=59870.0

 you can access it via .NET or C++. The only possible way for lisp is maybe this plug-in

http://www.theswamp.org/index.php?topic=58719

Also, this post may be of interest to cleanup using CGAL Polyline simplification.

Maybe this will make the lisp run faster

http://www.theswamp.org/index.php?topic=58641.msg622876#msg622876

[АлексЮстасу]

@marko_ribar,

Unfortunately this version of yours did not work for me:
Command:
Elapsed time : 1265 milliseconds...lisp value cannot be cast to this type OPTION: (-1.0e-06 -1.0e-06)
(I have a russified AutoCAD).
In English approximately: lisp value cannot be cast to given VARIANT type: (-1.0e-06 -1.0e-06)

Our lisp from #24 found self-intersections and self-overlaps for your attached simplified polyline with 1259 vertices in 17 seconds. That's only relatively good, long time.
It is incorrect to simplify polylines - users need their precision.

It seems to me that some very different ideas are needed.

[marko_ribar]

I changed my last posted code - retest it now... I think that CAD breaks because in line (vla-zoomwindow cad pt-lowerleft pt-upperright), pt has to be wrapped in (vlax-3d-point pt)... That way (vla-zoomwindow) has points as VARIANTS...

[АлексЮстасу]

@marko_ribar,

1. It would be more correct to make not just Move, but copies of the polyline, so that the original is preserved under all circumstances.
2. We tried to remove scaling. And we tried to move vla-zoomwindow above while, so that zoom is performed only once. And we got the same result.
We also tried disabling vla-zoomprevious, which is executed many times.
The execution time for a contour with 4600 vertices is 17-18 seconds.
3. There is no zeroing sets in your code. This is probably why AutoCAD sometimes stops working.
4. Can also try to look for actions that slow down the work. Remove/replace them or execute them before while or so on.
5. When (ssget “_C”...), can't unnecessary objects get into the set? It is possible that this should be excluded.
6. Now for many polylines there is no result message. This is an uncertainty.
7. Most cases of self-intersections and self-overlaps previously reported remain undiscovered.

[john.uhden]

@АлексЮстасу ,

I am still trying (latest attached), plus see image.

Notice that when segment 5->6 is straight, the solution is correct.

But when it is bulged, it considers both 5 and 6 as self intersections and I can't yet figure it out.

(defun selfinters (e / @2d @dupes pts dupes obj flat ints copy items css n leg d1 d2 d selfs)
  ;; John F. Uhden (11-22-2024 through 12-17-2024)
  ;; Function finds all self intersections of a LWPolyline,
  ;;   including intersections between vertices and at vertices
  ;;   where parameters are not consecutive.
  ;; Returns a list of self intersections.
  ;; This version explodes a copy of the polyline
  ;;   and operates on each resulting segment.
  ;; This version places a red circle at each vertex
  ;;   and a slightly larger green circle at each self intersection.
  ;;   Feel free to remove or rem out the lines containing (entmakex ...).
  ;; I may try a version that does not copy or explode to see if it's faster.
  (defun @2d (p)(mapcar '* p '(1 1)))
  (defun @dupes (pts / dupes)
    (while pts
      (and (vl-position (setq p (car pts))(setq pts (cdr pts)))
        (not (vl-position p dupes))
        (setq dupes (cons p dupes))
      )
    )
    dupes
  )
  (and
    (setq pts (mapcar 'cdr (vl-remove-if-not '(lambda (x)(= (car x) 10)) (entget e))))
(setvar "cmdecho" 0)
    (foreach p pts (entmakex (list '(0 . "CIRCLE")(cons 10 p)(cons 40 0.2)(cons 62 1))))
    (setq dupes (@dupes pts))
    (setq obj (vlax-ename->vla-object e))
    (setq flat (vlax-invoke obj 'intersectwith obj 0)) ;; flat list
    (while flat
      (repeat 3 (setq item (cons (car flat) item) flat (cdr flat)))
      (setq ints (cons (@2d (reverse item)) ints) item nil)
      1
    )
    (setq copy (vlax-vla-object->ename (vla-copy obj)))
    (vl-cmdf "_.explode" copy)
    (Setq css (ssget "_P"))
    (repeat (setq n (sslength css))
      (and
        (setq leg (ssname css (setq n (1- n))))
        (foreach int (reverse ints)
          (and
            (setq d (vlax-curve-getdistatpoint leg int))
            (setq d1 (vlax-curve-getdistatpoint leg (vlax-curve-getstartpoint leg)))
            (setq d2 (vlax-curve-getdistatpoint leg (vlax-curve-getendpoint leg)))
            (or
              (< d1 d d2)
              (< d2 d d1)
              (vl-position int dupes)
            )
            (not (vl-position int selfs))
            (setq selfs (cons int selfs))
          )
          1
        )
      )
    )
    (foreach p selfs (entmakex (list '(0 . "CIRCLE")(cons 10 p)(cons 40 0.3)(cons 62 3))))
    (vl-cmdf "_.erase" css "")
  )
  (setvar "cmdecho" 1)
  selfs
)

[АлексЮстасу]

@john.uhden,

I have circled in yellow where no self-intersections/self-overlaps/self-crossings are detected.
In red, no self-intersections/self-overlaps/self-touching are detected, and the Lines are obtained.

For polylines with coordinates in the millions, nothing is found.

But it works very fast!

[john.uhden]

@АлексЮстасу ,

Having nothing but an image to view, I have a limited idea of where a polyline begins or ends or its route, but I'm sure my results would be greatly more correct than what your image indicates.

Maybe that's because all my tests were in the coordinate range roughly from (13.x 4.y) to (19.x 10.y).

[marko_ribar]

Hi @john.uhden 

I took some time to ammend your sub function - to make it work as routine (command function)... Oddly I get different results than you - look at picture... Nevertheless I think that the code is now better structured - only thing I don't know is why now bottom - start/end point is not considered as self-intersecting-overlapping one... So, here is the code and the picture...

(defun c:selfinters ( / *error* selfinters cmd lw ti selfs )

  (defun *error* ( m selfs )
    (if (= 8 (logand 8 (getvar (quote undoctl))))
      (if command-s
        (command-s "_.undo" "_e")
        (vl-cmdf "_.undo" "_e")
      )
    )
    (if cmd
      (setvar (quote cmdecho) cmd)
    )
    (if m
      (progn
        (prompt "\n")
        (read (vl-princ-to-string selfs))
        (prompt m)
      )
      (progn
        (prompt "\n")
        (read (vl-princ-to-string selfs))
      )
    )
  )

  (defun selfinters ( e / @2d unique pts dupes obj flat ints copy items css n leg d1 d2 d selfs )
    ;; John F. Uhden (11-22-2024 through 12-17-2024)
    ;; Function finds all self intersections of a LWPolyline,
    ;;   including intersections between vertices and at vertices
    ;;   where parameters are not consecutive.
    ;; Returns a list of self intersections.
    ;; This version explodes a copy of the polyline
    ;;   and operates on each resulting segment.
    ;; This version places a red circle at each vertex
    ;;   and a slightly larger green circle at each self intersection.
    ;;   Feel free to remove or rem out the lines containing (entmakex ...).
    ;; I may try a version that does not copy or explode to see if it's faster.

    (defun @2d ( p ) (mapcar (function *) p (list 1.0 1.0)))

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

    (setq pts (mapcar (function cdr) (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) (entget e))))
    (setq dupes (unique pts 1e-8))
    (foreach p pts (entmakex (list (cons 0 "CIRCLE") (cons 10 p) (cons 40 0.2) (cons 62 1))))
    (setq obj (vlax-ename->vla-object e))
    (setq flat (vlax-invoke obj (quote intersectwith) obj 0))
    (while flat
      (repeat 3 (setq item (cons (car flat) item) flat (cdr flat)))
      (setq ints (cons (@2d (reverse item)) ints) item nil)
    )
    (setq copy (vlax-vla-object->ename (vla-copy obj)))
    (vl-cmdf "_.explode" copy)
    (setq css (ssget "_P"))
    (repeat (setq n (sslength css))
      (setq leg (ssname css (setq n (1- n))))
      (foreach int ints
        (if (vlax-curve-getparamatpoint leg int)
          (progn
            (setq d (vlax-curve-getdistatpoint leg int))
            (setq d1 (vlax-curve-getdistatpoint leg (vlax-curve-getstartpoint leg)))
            (setq d2 (vlax-curve-getdistatpoint leg (vlax-curve-getendpoint leg)))
            (if
              (and
                (not (equal d d1 1e-8))
                (not (equal d d2 1e-8))
                (not (vl-position int dupes))
                (not (vl-position int selfs))
              )
              (setq selfs (cons int selfs))
            )
          )
        )
      )
    )
    (foreach p selfs (entmakex (list (cons 0 "CIRCLE") (cons 10 p) (cons 40 0.3) (cons 62 3))))
    (vl-cmdf "_.erase" css "")
    selfs
  )

  (setq cmd (getvar (quote cmdecho)))
  (setvar (quote cmdecho) 0)
  (if (= 8 (logand 8 (getvar (quote undoctl))))
    (vl-cmdf "_.undo" "_e")
  )
  (vl-cmdf "_.undo" "_be")
  (if (setq lw (car (entsel "\nPick LWPOLYLINE to find self-intersecting points...")))
    (if (= (cdr (assoc 0 (entget lw))) "LWPOLYLINE")
      (progn
        (setq ti (car (_vl-times)))
        (setq selfs (selfinters lw))
        (prompt "\nElapsed time : ") (princ (rtos (- (car (_vl-times)) ti) 2 16)) (prompt " milliseconds...")
      )
      (prompt "\nPicked wrong entity type... Picked entity must be LWPOLYLINE... Better luck next time...")
    )
    (prompt "\nMissed... Better luck next time...")
  )
  (*error* nil selfs)
)

Regards,

HTH.

M.R.

[АлексЮстасу]

@john.uhden

I'm attaching my test files. 

[marko_ribar]

I did it... All I did was used @john.uhden sub function which I altered...

It finds both self-intersection points and overlapping points...

I'll attach my newest picture and of course post *.lsp...

(defun c:selfinters ( / *error* selfsinfo unique selfinters cmd lw ti mult sp selfs )

  (or (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-get-acad-object) nil))) (vl-load-com))

  (defun *error* ( m selfs sp )
    (if (= 8 (logand 8 (getvar (quote undoctl))))
      (if command-s
        (command-s "_.undo" "_e")
        (vl-cmdf "_.undo" "_e")
      )
    )
    (if cmd
      (setvar (quote cmdecho) cmd)
    )
    (if m
      (progn
        (prompt "\n")
        (if selfs
          (selfsinfo selfs)
        )
        (prompt "\n")
        (prompt m)
        (princ)
      )
      (progn
        (prompt "\n")
        (if selfs
          (selfsinfo selfs)
        )
        (prompt "\n")
        (princ)
      )
    )
  )

  (defun selfsinfo ( selfs )
    (setq selfs (mapcar (function (lambda ( x ) (mapcar (function +) sp x))) selfs))
    (setq selfs (mapcar (function (lambda ( x ) (mapcar (function (lambda ( y ) (* y 1e+6))) x))) (unique selfs 1e-12)))
    (princ
      (strcat "("
        (vl-string-right-trim " "
          (apply (function strcat)
            (mapcar
              (function
                (lambda ( x )
                  (strcat "("
                    (vl-string-right-trim " "
                      (apply (function strcat)
                        (mapcar
                          (function
                            (lambda ( y )
                              (strcat (rtos y 2 16) " ")
                            )
                          )
                          x
                        )
                      )
                    )
                    ") "
                  )
                )
              )
              selfs
            )
          )
        )
        ")"
      )
    )
  )

  (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 selfinters ( e sp mult / @2d @dupes pts dupes obj flat ints copy items css n leg d1 d2 d ppp ents selfs )

    ;; John F. Uhden (11-22-2024 through 12-17-2024)
    ;; Function finds all self intersections of a LWPolyline,
    ;;   including intersections between vertices and at vertices
    ;;   where parameters are not consecutive.
    ;; Returns a list of self intersections.
    ;; This version explodes a copy of the polyline
    ;;   and operates on each resulting segment.
    ;; This version places a red circle at each vertex
    ;;   and a slightly larger green circle at each self intersection.
    ;;   Feel free to remove or rem out the lines containing (entmakex ...).
    ;; I may try a version that does not copy or explode to see if it's faster.

    (defun @2d ( p ) (mapcar (function *) p (list 1.0 1.0)))

    (defun @dupes ( lst / a rtn )
      (while (setq a (car lst))
        (if (vl-position a (cdr lst))
          (setq rtn (cons a rtn))
        )
        (setq lst (cdr lst))
      )
      (unique rtn 1e-8)
    )

    (setq pts (mapcar (function cdr) (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) (entget e))))
    (setq dupes (@dupes pts))
    (setq pts (unique pts 1e-8))
    (setq ppp pts)
    (setq ppp (mapcar (function (lambda ( x ) (mapcar (function +) sp x))) ppp))
    (setq ppp (mapcar (function (lambda ( x ) (mapcar (function (lambda ( y ) (* y 1e+6))) x))) (unique ppp 1e-12)))
    (foreach p ppp (entmakex (list (cons 0 "CIRCLE") (cons 10 p) (cons 40 (* mult 0.2)) (cons 62 1))))
    (setq obj (vlax-ename->vla-object e))
    (setq flat (vlax-invoke obj (quote intersectwith) obj 0))
    (while flat
      (repeat 3 (setq item (cons (car flat) item) flat (cdr flat)))
      (setq ints (cons (@2d (reverse item)) ints) item nil)
    )
    (setq copy (vlax-vla-object->ename (vla-copy obj)))
    (vl-cmdf "_.explode" copy)
    (setq css (ssget "_P"))
    (setq ents
      (vl-remove-if
        (function listp)
        (mapcar
          (function cdr)
          (ssnamex css)
        )
      )
    )
    (repeat (setq n (sslength css))
      (setq leg (ssname css (setq n (1- n))))
      (foreach int (append ints pts)
        (if (vlax-curve-getparamatpoint leg int)
          (progn
            (setq d (vlax-curve-getdistatpoint leg int))
            (setq d1 (vlax-curve-getdistatpoint leg (vlax-curve-getstartpoint leg)))
            (setq d2 (vlax-curve-getdistatpoint leg (vlax-curve-getendpoint leg)))
            (if
              (or
                (and
                  (or
                    (equal d d1 1e-8)
                    (equal d d2 1e-8)
                  )
                  (vl-some
                    (function
                      (lambda ( x )
                        (and
                          (vlax-curve-getparamatpoint x int)
                          (not (equal 0.0 (vlax-curve-getparamatpoint x int) 1e-8))
                        )
                      )
                    )
                    (vl-remove leg ents)
                  )
                  (not (vl-position int selfs))
                )
                (and
                  (vl-position int dupes)
                  (not (vl-position int selfs))
                )
                (and
                  (not (equal d d1 1e-8))
                  (not (equal d d2 1e-8))
                  (not (vl-position int selfs))
                )
              )
              (setq selfs (cons int selfs))
            )
          )
        )
      )
    )
    (setq ppp selfs)
    (setq ppp (mapcar (function (lambda ( x ) (mapcar (function +) sp x))) ppp))
    (setq ppp (mapcar (function (lambda ( x ) (mapcar (function (lambda ( y ) (* y 1e+6))) x))) (unique ppp 1e-12)))    
    (foreach p ppp (entmakex (list (cons 0 "CIRCLE") (cons 10 p) (cons 40 (* mult 0.3)) (cons 62 3))))
    (vl-cmdf "_.erase" css "")
    selfs
  )

  (setq cmd (getvar (quote cmdecho)))
  (setvar (quote cmdecho) 0)
  (if (= 8 (logand 8 (getvar (quote undoctl))))
    (vl-cmdf "_.undo" "_e")
  )
  (vl-cmdf "_.undo" "_be")
  (if (setq lw (car (entsel "\nPick LWPOLYLINE to find self-intersecting points...")))
    (if (= (cdr (assoc 0 (entget lw))) "LWPOLYLINE")
      (progn
        (initget 6)
        (setq mult (cond ( (getdist "\nPick or specify multiplication factor for circles size <1.0> : ") ) ( 1.0 )))
        (setq ti (car (_vl-times)))
        (vl-cmdf "_.scale" lw "" "_non" (list 0.0 0.0 0.0) 1e-6)
        (vl-cmdf "_.move" lw "" "_non" (setq sp (vlax-curve-getstartpoint lw)) "_non" (list 0.0 0.0 0.0))
        (setq selfs (selfinters lw sp mult))
        (vl-cmdf "_.move" lw "" "_non" (list 0.0 0.0 0.0) "_non" sp)
        (vl-cmdf "_.scale" lw "" "_non" (list 0.0 0.0 0.0) 1e+6)
        (prompt "\nElapsed time : ") (princ (rtos (- (car (_vl-times)) ti) 2 16)) (prompt " milliseconds...")
      )
      (prompt "\nPicked wrong entity type... Picked entity must be LWPOLYLINE... Better luck next time...")
    )
    (prompt "\nMissed... Better luck next time...")
  )
  (*error* nil selfs sp)
)

Regards,

M.R.

[АлексЮстасу]

@marko_ribar, @john.uhden,

Yes, all intersections/overlaps/touching are now located!

A little extra - the coincidence of the first and the last point does not need to be considered as a touching-intersection.
And on a contour with 4600 vertices it became very slow - 158 seconds.

[marko_ribar]

Just to inform...

I've added scale multiplication factor for circles and changed output info with better precision of coordinates of founded self-intersecting-overlapping points...

You can now create routine called : selfinters.lsp by copy+pasting code from code tag to notepad or notepad++ and save the code as *.lsp...

[john.uhden]

@marko_ribar ,

You are so very kind.

Other than the packaging into a command function, I haven't studied your code to see how you disregarded the vertices at the ends of the arc segment.

Yes, I should have added the circle scaling.

How about if you finish it off and mention me as a credit?  There's no need to have multiple versions clogging up the "world wide web."  😲

[marko_ribar]

@john.uhden 

I left header of sub function you posted, so it's your code for which I am just giving credit... Just liked 2 your replyes, but OP is not showing... (this topic is probably too old that we have to wait for accepting some of posts as solution...) I don't know, maybe something happened to OP meanwhile, or he just don't want to show up...

I'd like that this second thought of mine is correct...