help I need find vertex displaced or not overlappping

[DAVID_OJEDA]

Good evening CAD Gurus. I request your valuable help with a lisp routine, that you can share with me, I have hundreds of files with adjacent closed polylines and all of them must coincide in the vertices, however, it is not always so, since there are vertices that do not overlap and are displaced by minimum distances, or there are vertices at the midpoints of another polyline, is there a way to locate the failure points with a lisp routine and circle the vertices separated or located at the midpoint of the adjacent polyline?

 

thank you I appreciate your attention and help

EXAMPLE.dwg

[mhupp]

Lisp inspired from this post

Looks like plots how are you determining the correct locations do you have survey information?

 

This creates circles on the vertex of each polyline. then adds them to a selection set. if their is another circle center between a distance of 0.001 to 0.5 it add that circle to another list if not it deletes the circle. this will insure all circles between this distance are left and highlight where the vertex's don't match.

 

Also attached your example drawing with this lisp ran on it. Having a total of 31 problem areas. if you increase the precision of 0.001 it will add more areas.

 

;;----------------------------------------------------------------------;;
;; ADD CIRCES TO EACH VERTEX OF A POLYLINE THAT DON'T MATCH.
(defun C:PPCIR (/ SS S cords d ent a b c)
  (if (setq SS (ssget '((0 . "*POLYLINE"))))
    (foreach poly (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))
      (setq cords (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget poly))))
      (foreach pt cords
        (entmake (list '(0 . "CIRCLE") (cons 10 pt) '(40 . 2) '(8 . "Mark"))) ;creat a circle with a radius of 2
      )
    )
  )
  (cond
    ((setq S (ssget "_X" '((0 . "CIRCLE") (8 . "Mark"))))
      (foreach ent (mapcar 'cadr (ssnamex S))
        (setq a (cons (list (cdr (assoc 10 (entget ent))) ent) a))
      )
      (while (setq c (car a))
        (setq a (cdr a))
        (if (or (member t (mapcar '(lambda (x) (and (not (equal (car c) (car x) 0.001)) (<= (distance (car c) (car x)) 0.5))) a))
                (member t (mapcar '(lambda (x) (and (not (equal (car c) (car x) 0.001)) (<= (distance (car c) (car x)) 0.5))) b)))
          (setq b (cons c b))
          (entdel (cadr c))
        )
      )
    )
  )
  (princ)
)

 

 

Example.dwg

Edited May 29, 2023 by mhupp

[DAVID_OJEDA]

Thank you very much I appreciate it very much it works wonderfully.

[leo321]

Go forward; other lisp to force overlapping (closed vertex)... it is possible?