To Find Self Intersection of LWPOLYLINE
Just slightly different, but still it can't find self-intersecting point on example shown in the picture...
Here is my latest attempt and I think that is better than my previous IMHO...
(defun c:self-inters-overls ( / *error* removeonce self-inters-overls ent 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)
)
(princ)
)
)
(if lst
(progn
(prompt "\n")
(read (vl-princ-to-string lst))
)
)
)
(defun removeonce ( a l fuzz / n c d )
(setq n
(vl-some
(function
(lambda ( x )
(setq c (if (not c) 0 (1+ c)))
(if (equal x a fuzz) c)
)
)
l
)
)
(vl-remove nil
(mapcar
(function
(lambda ( x )
(setq d (if (not d) 0 (1+ d)))
(if (= d n) nil x)
)
)
l
)
)
)
(defun self-inters-overls ( obj / vertlst selfintlst vl sl )
(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)
)
)
( (= (cdr (assoc 0 enx)) "SPLINE")
(mapcar (function cdr)
(vl-remove-if
(function
(lambda ( x )
(or
(/= (car x) 10)
(/= (car x) 11)
)
)
)
enx
)
)
)
)
)
(defun selfintlst ( obj / lst rtn )
(setq lst
(vlax-invoke
(if (= (type obj) (quote ename))
(vlax-ename->vla-object obj)
obj
)
(quote intersectwith)
(if (= (type obj) (quote ename))
(vlax-ename->vla-object obj)
obj
)
acextendnone
)
)
(repeat (/ (length lst) 3)
(setq rtn
(cons
(list (car lst) (cadr lst) (caddr lst))
rtn
)
)
(setq lst (cdddr lst))
)
(reverse rtn)
)
(if
(not
(vl-catch-all-error-p
(vl-catch-all-apply
(function vlax-curve-getstartpoint)
(list obj)
)
)
)
(progn
(setq vl (vertlst obj))
(setq sl (selfintlst obj))
(foreach x vl
(setq sl (removeonce x sl 1e-6))
)
sl
)
(progn
(prompt "\nInvalid entity pick... Picked entity must be AcDbCurve... Better luck next time...")
(exit)
)
)
)
(if (setq ent (car (entsel "\nPick curve entity to get its self-intersecting-overlapping points...")))
(setq lst (self-inters-overls ent))
(prompt "\nMissed... Better luck next time...")
)
(*error* nil)
)
HTH.
Regards, M.R.
