Jump to content

Nearest Points


giskumar

Recommended Posts

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.

Link to comment
Share on other sites

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).

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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 by Lee Mac
Link to comment
Share on other sites

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

Link to comment
Share on other sites

  • 10 years later...
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 ?

Link to comment
Share on other sites

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)
)

 

  • Like 1
Link to comment
Share on other sites

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

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...