Nearest Points

[giskumar]

Hi,

 

I am having thousands of points in my drawing. I want mark only those points which are having less than 1mt distance between them.

 

Please let me know how can i do this.

 

Thanks,

Kumar.

[MSasu]

I will do it like this:

1. Use SSGET with an appropriate filter to collect all points from drawing.
   
2. Using first point (SSNAME) from selection set as reference, parse the rest of selection set and use DISTANCE function to check if current point matches the location condition. Extract the coordinates with ENTGET and ASSOC.
   
3. Change the color of points that pass the test (or other marking); let the others untouched.
   
4. Remove first point from selection set to avoid double verifications (SSDEL) and repeat steps 2 to 4 until there is only one point left in selection set (SSLENGTH).
   

[giskumar]

Hi,

 

Thanks for the reply.

 

This logic working fine. For large data (50,000 points), it is taking lot of time.

Is there any better way to improve speed?

 

 

Thanks,

Kumar.

[David Bethel]

Maybe:

 

[b][color=BLACK]([/color][/b]defun c:mxdp [b][color=FUCHSIA]([/color][/b]/ mx ss i en ed pl[b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]setq el [b][color=NAVY]([/color][/b]ssadd[b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]initget 6[b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]setq mx [b][color=NAVY]([/color][/b]getdist [color=#2f4f4f]"\nMax Seperation <1>:   "[/color][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]or mx [b][color=NAVY]([/color][/b]setq mx 1[b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]if [b][color=NAVY]([/color][/b]setq ss [b][color=MAROON]([/color][/b]ssget '[b][color=GREEN]([/color][/b][b][color=BLUE]([/color][/b]0 . [color=#2f4f4f]"POINT"[/color][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
     [b][color=NAVY]([/color][/b]progn
       [b][color=MAROON]([/color][/b]setq i [b][color=GREEN]([/color][/b]sslength ss[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
       [b][color=MAROON]([/color][/b]while [b][color=GREEN]([/color][/b]not [b][color=BLUE]([/color][/b]minusp [b][color=RED]([/color][/b]setq i [b][color=PURPLE]([/color][/b]1- i[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
              [b][color=GREEN]([/color][/b]setq en [b][color=BLUE]([/color][/b]ssname ss i[b][color=BLUE])[/color][/b]
                    ed [b][color=BLUE]([/color][/b]entget en[b][color=BLUE])[/color][/b]
                    pl [b][color=BLUE]([/color][/b]cons [b][color=RED]([/color][/b]list [b][color=PURPLE]([/color][/b]cdr [b][color=TEAL]([/color][/b]assoc 10 ed[b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b]
                                   [b][color=PURPLE]([/color][/b]cdr [b][color=TEAL]([/color][/b]assoc -1 ed[b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b] pl[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
       [b][color=MAROON]([/color][/b]foreach a pl
          [b][color=GREEN]([/color][/b]foreach m pl
             [b][color=BLUE]([/color][/b]cond [b][color=RED]([/color][/b][b][color=PURPLE]([/color][/b]and [b][color=TEAL]([/color][/b]not [b][color=OLIVE]([/color][/b]eq [b][color=GRAY]([/color][/b]cadr a[b][color=GRAY])[/color][/b] [b][color=GRAY]([/color][/b]cadr m[b][color=GRAY])[/color][/b][b][color=OLIVE])[/color][/b][b][color=TEAL])[/color][/b]
                         [b][color=TEAL]([/color][/b]<= [b][color=OLIVE]([/color][/b]distance [b][color=GRAY]([/color][/b]car a[b][color=GRAY])[/color][/b] [b][color=GRAY]([/color][/b]car m[b][color=GRAY])[/color][/b][b][color=OLIVE])[/color][/b] mx[b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b]
                    [b][color=PURPLE]([/color][/b]if [b][color=TEAL]([/color][/b]not [b][color=OLIVE]([/color][/b]ssmemb [b][color=GRAY]([/color][/b]cadr a[b][color=GRAY])[/color][/b] el[b][color=OLIVE])[/color][/b][b][color=TEAL])[/color][/b]
                        [b][color=TEAL]([/color][/b]ssadd [b][color=OLIVE]([/color][/b]cadr a[b][color=OLIVE])[/color][/b] el[b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b]
                    [b][color=PURPLE]([/color][/b]if [b][color=TEAL]([/color][/b]not [b][color=OLIVE]([/color][/b]ssmemb [b][color=GRAY]([/color][/b]cadr m[b][color=GRAY])[/color][/b] el[b][color=OLIVE])[/color][/b][b][color=TEAL])[/color][/b]
                        [b][color=TEAL]([/color][/b]ssadd [b][color=OLIVE]([/color][/b]cadr m[b][color=OLIVE])[/color][/b] el[b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]prin1 [b][color=NAVY]([/color][/b]sslength el[b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]

 

 

variable 'el is a PICKSET that contains the points and is global

 

These kind of functions can be very slow on large quanties of points

-David

[Tharwat]

david , with the prin1 function and the sslength function would print the number of selection set two times to the command line .

[MSasu]

For large data (50,000 points), it is taking lot of time.

Is there any better way to improve speed?

That’s true, it will take some time. But I really cannot see other optimization than removing the previous reference point from selection set to avoid double validation; also, by not comparing the points with himself, don’t need to add another parameter to the validation (i.e. entity name) to take care for overlapped points. Let’s hope someone will come with a better optimization/solution.

[Lee Mac]

Here's another version, using a divide & conquer algorithm:

 

;; Near Points  -  Lee Mac
;; Creates a selection set of all points separated by a specified distance or less.
;; Utilises a divide & conquer algorithm.

(defun c:nearpoints ( / a b e f i r s x y )
   (if (setq s (ssget '((0 . "POINT"))))
       (progn
           (initget 6)
           (setq f (cond ((getdist "\nSpecify Tolerance <1.0>: ")) (1.0)))
           (setq a
               (vl-sort
                   (repeat (setq i (sslength s))
                       (setq e (ssname s (setq i (1- i)))
                             a (cons (cons (cdr (assoc 10 (entget e))) e) a)
                       )
                   )
                  '(lambda ( a b ) (<= (caar a) (caar b)))
               )
           )
           (setq r (ssadd))
           (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
                           (ssadd (cdr x) r)
                           (ssadd (cdr y) r)
                       )
                   )
                   (setq b (cdr b))
               )
           )
           (sssetfirst nil r)
       )
   )
   (princ)
)

 

Edited June 19, 2023 by Lee Mac

[David Bethel]

david , with the prin1 function and the sslength function would print the number of selection set two times to the command line .

 

I used that as a way to show the selection set. The OP didn't say what they were going to do with entities. -David

[giskumar]

Hi Lee Mac,

 

Thanks for the help, Its working with Excellent Speed.

 

Thnaks a Lot.

Kumar.

[Lee Mac]

Hi Lee Mac,

 

Thanks for the help, Its working with Excellent Speed.

 

Thnaks a Lot.

Kumar.

 

That's great to hear Kumar, you're welcome.

[bilalntk1]

On 10/3/2012 at 5:07 PM, Lee Mac said:

 

That's great to hear Kumar, you're welcome.

Hi Mac

this is not working for me. is there any updated version of the same ?

[Isaac26a]

I don't know but this is working pretty well on my end, maybe is the old webpage code that is causing you problems, here is the code again

;; Near Points  -  Lee Mac
;; Creates a selection set of all points separated by a specified distance or less.
;; Utilises a divide & conquer algorithm.

(defun c:nearpoints ( / a b e f i r s x y )
   (if (setq s (ssget '((0 . "POINT"))))
       (progn
           (initget 6)				;;; No 0 or negative allowed
           (setq f (cond ((getdist "\nSpecify Tolerance <1.0>: ")) (1.0)))
           (setq a
               (vl-sort
                   (repeat (setq i (sslength s))
                       (setq e (ssname s (setq i (1- i)))
                             a (cons (cons (cdr (assoc 10 (entget e))) e) a)
                       )
                   )
                  '(lambda ( a b ) (<= (caar a) (caar b)))
               )
           )
           (setq r (ssadd))
           (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
                           (ssadd (cdr x) r)
                           (ssadd (cdr y) r)
                       )
                   )
                   (setq b (cdr b))
               )
           )
           (sssetfirst nil r)
       )
   )
   (princ)
)

 

[bilalntk1]

This is Working Fine.. Thank you Bro

[bilalntk1]

20 hours ago, Isaac26a said:

I don't know but this is working pretty well on my end, maybe is the old webpage code that is causing you problems, here is the code again

;; Near Points  -  Lee Mac
;; Creates a selection set of all points separated by a specified distance or less.
;; Utilises a divide & conquer algorithm.

(defun c:nearpoints ( / a b e f i r s x y )
   (if (setq s (ssget '((0 . "POINT"))))
       (progn
           (initget 6)				;;; No 0 or negative allowed
           (setq f (cond ((getdist "\nSpecify Tolerance <1.0>: ")) (1.0)))
           (setq a
               (vl-sort
                   (repeat (setq i (sslength s))
                       (setq e (ssname s (setq i (1- i)))
                             a (cons (cons (cdr (assoc 10 (entget e))) e) a)
                       )
                   )
                  '(lambda ( a b ) (<= (caar a) (caar b)))
               )
           )
           (setq r (ssadd))
           (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
                           (ssadd (cdr x) r)
                           (ssadd (cdr y) r)
                       )
                   )
                   (setq b (cdr b))
               )
           )
           (sssetfirst nil r)
       )
   )
   (princ)
)

 

This is Working Fine.. Thank you Bro

[Lee Mac]

A few years ago an update to the forum software caused formatting codes to become visible in code posts - I have now updated my earlier post to remove these.