Lisp to list duplicate points

[Baber62]

I am looking for lisp routine to list duplicate points in a drawing. I have managed to find ones which can remove duplicate points but not any that can list duplicate points.

 

Thanks for your assists in advance.

[David Bethel]

Are you talking about POINT entities ? What tolerance do you need ? Are layers considered ? Colors ?

 

-David

[Baber62]

Hi David,

 

Yes I am talking about point entities. The tolerance I would be looking at is the exact co-ordinates of the points say from either a topographical survey or from GIS Mapping converted to AutoCAD points. I have looked at layers and it does seem that some of the points have been entered in twice at some co-ordinates. Tolerances would need to be 0.001 working in metres.

Although I think I have found the answer after searching on this last night on CADTutor. David you answered in the following link.

 

http://www.cadtutor.net/forum/showthread.php?94248-Selecting-Duplicate-Points/page2

 

However, I need to generate a list showing the duplicate co-ordinates which can then be exported as a csv file. Any ideas would be appreciated.

[Lee Mac]

The following is untested but should perform as required:

(defun c:listdupepoints ( / d f i l s )
   (if (setq s (ssget '((0 . "POINT"))))
       (progn
           (repeat (setq i (sslength s))
               (setq p (cdr (assoc 10 (entget (ssname s (setq i (1- i)))))))
               (if (vl-some (function (lambda ( x ) (equal p x 1e-3))) l)
                   (setq d (cons p d))
                   (setq l (cons p l))
               )
           )
           (cond
               (   (not d) 
                   (princ "\nNo duplicate points found.")
               )
               (   (not (setq f (getfiled "" "" "csv" 1))) 
                   (princ "\n*Cancel*")
               )
               (   (setq f (open f "w"))
                   (foreach p d 
                       (write-line 
                           (apply 'strcat 
                               (mapcar '(lambda ( x y ) (strcat (rtos x) y)) p '("," "," ""))
                           )
                           f
                       )
                   )
                   (close f)
               )
               (   (princ "\nUnable to open file for writing."))
           )
       )
   )
   (princ)
)

[symoin]

On 10/27/2015 at 12:40 PM, Lee Mac said:

The following is untested but should perform as required:

 

(defun c:listdupepoints ( / d f i l s )
   (if (setq s (ssget '((0 . "POINT"))))
       (progn
           (repeat (setq i (sslength s))
               (setq p (cdr (assoc 10 (entget (ssname s (setq i (1- i)))))))
               (if (vl-some (function (lambda ( x ) (equal p x 1e-3))) l)
                   (setq d (cons p d))
                   (setq l (cons p l))
               )
           )
           (cond
               (   (not d) 
                   (princ "\nNo duplicate points found.")
               )
               (   (not (setq f (getfiled "" "" "csv" 1))) 
                   (princ "\n*Cancel*")
               )
               (   (setq f (open f "w"))
                   (foreach p d 
                       (write-line 
                           (apply 'strcat 
                               (mapcar '(lambda ( x y ) (strcat (rtos x) y)) p '("," "," ""))
                           )
                           f
                       )
                   )
                   (close f)
               )
               (   (princ "\nUnable to open file for writing."))
           )
       )
   )
   (princ)
)

 

 

Hi,

 can it select the duplicate points (more than 1 on the same position) keeping one at its position and to paste it to another dwg (ctr+c and ctr+v) for checking

[Lee Mac]

1 hour ago, symoin said:

 can it select the duplicate points (more than 1 on the same position) keeping one at its position and to paste it to another dwg (ctr+c and ctr+v) for checking

 

Sure - try this (untested):

(defun c:listdupepoints ( / d e i l p s )
    (if (setq s (ssget '((0 . "POINT"))))
        (progn
            (setq d (ssadd))
            (repeat (setq i (sslength s))
                (setq i (1- i)
                      e (ssname s i)
                      p (cdr (assoc 10 (entget e)))
                )
                (if (vl-some (function (lambda ( x ) (equal p x 1e-3))) l)
                    (ssadd e d)
                    (setq l (cons p l))
                )
            )
            (if (zerop (sslength d))
                (princ "\nNo duplicate points found.")
                (sssetfirst nil d)
            )
        )
    )
    (princ)
)

 

[symoin]

Thankyou Lee, it perfect