Find points pairs with distance tolerance

[ctdlc888]

Hi lisp masters.I have searched here a lot but could'nt find a lisp which can identify
almost duplicate points,what i found are duplicate finders.Say i need to know which points are closer by less than 5meters(or any number tolerance). We always receive drawings with many GPS XY coordinates with plenty multiple observations/coordinates which should count as one. We need exact counting.
Thanks for help.

[SLW210]

I moved this to the AutoLISP, Visual LISP & DCL forum.

[ketxu]

Why don't you post your drawing, and what is the result that you want?

[pBe]

<Limited testing> ------->Further testing resulted in FAILURE to give accurate count

(defun c:test  (/ seek fuzz cnt i plst)
(vl-load-com)
(defun seek  (pt fz lst / sk lst)
            (setq sk   (ssget "_C"
                              (polar pt (* pi 0.25) (* fz (sqrt 2)))
                              (polar pt (* pi 1.25) (* fz (sqrt 2)))
                              '((0 . "POINT"))))
            (repeat (sslength sk)
                  (setq lst (cons (ssname sk 0) lst))
                  (ssdel (ssname sk 0) sk))
            lst
            )
      (if (and (setq fuzz (getdist "\nEmter Fuzz Value: "))
               (setq plst nil
                     cnt  0
                     ss   (ssget "_X" (list '(0 . "POINT")(cons 410 (getvar 'Ctab))))))
            (progn (vla-zoomextents (vlax-get-acad-object))
                  (repeat (setq i (sslength ss))
                         (setq en (ssname ss (setq i (1- i))))
                         (if (not (member en plst))
                               (setq plst (seek (cdr (assoc 10
                                                            (entget en)))
                                                fuzz
                                                plst)
                                     cnt  (1+ cnt))(entmod (subst (cons 8 "DuplicatePoints")
                                                                  (assoc 8 (entget en)) (entget en))))
                         )
                   (princ (strcat "\n"
                                  (itoa cnt)
                                  " Points Found")))
            )
      (princ)
      )

UPDATED to include place duplicates on Layer "DuplicatePoints"
:::::Code Failure: :::::

[David Bethel]

I'd try:

(defun c:findpt (/ fuzz ss bp ps en pp) ; ts is global
  (initget 7)
  (setq fuzz (getdist "\nTolerance Distance:   "))
  (and (princ "\nSelect Base Point:   ")
       (setq ss (ssget '((0 . "POINT"))))
       (= (sslength ss) 1)
       (setq bp (cdr (assoc 10 (entget (ssname ss 0)))))
       (setq ps (ssget "_C" (list (- (car bp) fuzz) (- (cadr bp) fuzz))
                            (list (+ (car bp) fuzz) (+ (cadr bp) fuzz))
                           '((0 . "POINT"))))
       (setq ts (ssadd))
       (while (setq en (ssname ps 0))
              (setq pp (cdr (assoc 10 (entget en))))
              (and (not (equal bp pp))
                   (<= (distance bp pp) fuzz)
                   (ssadd en ts))
              (ssdel en ps))
       (prin1 (sslength ts)))
  (prin1))

I don't think that the "W" ssget filter will return correct results. -David

Also, please remember that point values are calculated in 3D

[pBe]

You may have a point there David...

I'll have a look-see. tnx

[Lee Mac]

Here is a 'Divide and Conquer' method:

(defun c:ptcount ( / a b d e f i s x y )

    (setq f  5.0 ;; Tolerance
          d '(8 . "$DUPLICATE-POINTS$") ;; Duplicate Points Layer
    )
    (if (setq s (ssget "_X" '((0 . "POINT") (410 . "Model"))))
        (progn
            (setq a
                (vl-sort
                    (repeat (setq i (sslength s))
                        (setq e (entget (ssname s (setq i (1- i))))
                              a (cons (cons (cdr (assoc 10 e)) e) a)
                        )
                    )
                   '(lambda ( a b ) (<= (caar a) (caar b)))
                )
            )
            (while (setq x (car a))
                (setq a (cdr a)
                      b a
                )
                (while (and (setq y (car b)) (<= (- (caar y) (caar x)) f))
                    (if (<= (distance (car x) (car y)) f)
                        (progn
                            (entmod (subst d (assoc 8 (cdr y)) (cdr y)))
                            (ssdel (cdr (assoc -1 (cdr y))) s)
                        )
                    )
                    (setq b (cdr b))
                )
            )
            (princ (strcat "\n" (itoa (sslength s)) " Distinct Points to a Tolerance of " (rtos f 2 15)))
        )
    )
    (princ)
)

Duplicate points will be placed on a separate layer.

[pBe]

Updated the code [post #4]


Unlike Davids and LMs code that used distance function.I opted to use llist to control selection, that way i dont neet to take into account the Z value. but still osmode whould be set and current zoom will be a factor hee.

[ctdlc888]

Tanks good guys pBe,David,LeeMac i'll try them.
@ketxu here's my prob..
http://www.4shared.com/photo/tTI3tUks/AcadDup.html

[ctdlc888]

@LM.Can we have a prompt for input of tolerance and color of the new layer?
if not too much of asking .thanks
Yours WORKED VERY FINE. I just change 'setq f 5' to other number for tolerance