Deleting Duplicate Points

[fallen]

Hi to all, i'm a newbie

Anyway i have a code segment which is deleting duplicate points in the selection area, it searches entire selection set and compare points in 2 dimension. for example, code runned 1 minute and 40 secs for 240.000 points. if u interested i can share the code segment

 

Thank you.

[ReMark]

First post and he's already teasing us. Smarty pants.

[fallen]

thanks for replying me ReMark. Are you interested ?

[ReMark]

Sure thing fallen. No bugs or viruses in it are there? Can't be too careful these days you know.

[fallen]

Sure ain't in it, it's just a code segment written in lisp, and still needs modification u know, and still ended with an error but it works!

[Cad64]

Why are we even discussing this?

 

If you want to post the code, then post it. But I don't know why anyone would want a lisp routine that doesn't work? You say it ends in an error, so that means it doesn't work.

 

I have moved this thread to the lisp section, so go ahead and post your code and maybe one of the guys here will take a look at it and give you a suggestion as to how to get it working correctly.

[fallen]

sorry for this, but as i said i'm a newbie here, sorry for this again, next post i'll give the code

[Cad64]

Why didn't you just put it in your last post?

 

I'm starting to get the feeling that you're just trying to boost your post count so you can post a link to some bogus website.

 

I will be expecting to see the code in your next reply.

[ReMark]

The above is referred to as a "gotcha". You better pony up fallen or else it is off to the gallows with you.

[fallen]

no! ok here is the code i just trying to fix the error.

waiting for suggestions

 

(defun dupsil ()

(setq i 0 p1 nil p2 nil p3 nil p4 nil i1 0 i5 0)

(setq sec (ssget '((0 . "POINT"))))

(setq uzunluk (sslength sec))

(while (

(setq p4 nil ss1 nil)

(if (/= (setq b (cdr (assoc 10 (entget (ssname sec i))))) nil)

(progn

(setq p1 (mapcar '(lambda (x y) (+ x y)) b '(0 200 0)))

(setq p2 (mapcar '(lambda (x y) (+ x y)) b '(200 -200 0)))

(setq p3 (mapcar '(lambda (x y) (+ x y)) b '(-200 -200 0)))

(setq p4 (append p4 (list p1) (list p2) (list p3)))

(setq p4 (apply 'append (list (mapcar '(lambda (x) (list (car x) (cadr x))) p4))))

 

(setq ss1 (ssget "_CP" p4))

 

(if (> (sslength ss1) 1)

(progn

(setq i5 (1+ i5))

(setq i1 0 p5 nil)

(while (

(setq p5 (append p5 (list (cdr (assoc 10 (entget (ssname ss1 i1)))))))

(setq i1 (1+ i1))

)

(setq p5 (apply 'append (list (mapcar '(lambda (x) (list (car x) (cadr x))) p5))))

 

(setq p6 (vl-sort-i p5

(function

(lambda (e1 e2)

(

(setq i1 0)

(while (

(if (

(progn

(setq i5 (1+ i5))

(entdel (ssname ss1 (nth i1 p6)))

)

)

(ssdel (ssname ss1 (nth i1 p6)) sec)

(setq i1 (1+ i1))

)

)

)

 

 

(setq i (1+ i))

)

)

)

)

[fallen]

don't mind the error!! it is working u can test it by re-select the point set after running the code.

[Lee Mac]

Would something like this not suffice?

 

(defun c:DelDupes ( / ss )
 ;; © Lee Mac 2010

 (if (setq ss (ssget "_X" '((0 . "POINT"))))
   (
     (lambda ( i / e1 e2 p1 p2 )
       
       (while (not (minusp (setq j (1- i) i (1- i))))
         (setq e1 (ssname ss i) p1 (cdr (assoc 10 (entget e1))))

         (while (not (minusp (setq j (1- j))))
           (setq e2 (ssname ss j) p2 (cdr (assoc 10 (entget e2))))

           (if (equal p1 p2) (progn (entdel e2) (ssdel e2 ss)))
         )
       )
     )
     (sslength ss)
   )
 )
 (princ)
)

[fallen]

Lee Mac, i will run the code ,

and discuss it.

 

Thanks

[alanjt]

I'm sure I'm missing something, but would this work?

 

(defun test (/ ss lst)
 (if (setq ss (ssget "_:L" '((0 . "POINT"))))
   ((lambda (i / p)
      (while (setq e (ssname ss (setq i (1+ i))))
        (if (vl-position (setq p (cdr (assoc 10 (entget e)))) lst)
          (entdel e)
          (setq lst (cons p lst))
        )
      )
    )
     -1
   )
 )
 ss
)

BTW, read this: Code Posting Etiquette

[fallen]

Lee Mac, i have ran the code for 34000 points (not random, acquired from terrain readings) i think it overflows or something. i stopped it. cause, 2 minutes elapsed and still there is no response. i think it searches the points one by one.

 

Thank you

[Lee Mac]

I'm sure I'm missing something, but would this work?

 

(defun test (/ ss lst)
 (if (setq ss (ssget "_:L" '((0 . "POINT"))))
   ((lambda (i / p)
      (while (setq e (ssname ss (setq i (1+ i))))
        (if (vl-position (setq p (cdr (assoc 10 (entget e)))) lst)
          (entdel e)
          (setq lst (cons p lst))
        )
      )
    )
     -1
   )
 )
 ss
)

BTW, read this: Code Posting Etiquette

 

Nice one Alan, much better - mine was stupidly running through the SelSet too many times...

[fallen]

alanjt, thanks for post, but i think it may suffers at large numbers of points but i will run your code.

thank u

[fallen]

alanjt, i' ve ran ur code it is a good one, tested ur code for 34000 points, elapsed time 65 seconds,

thank u

[alanjt]

Nice one Alan, much better - mine was stupidly running through the SelSet too many times...

Thanks. I was sure I was missing something.

 

alanjt, i' ve ran ur code it is a good one, tested ur code for 34000 points, elapsed time 65 seconds,

thank u

You're welcome. Here's a cleaner copy of it as an actual routine:

 

(defun c:DDP (/ ss lst)
 ;; Delete Duplicate Points
 ;; Alan J. Thompson, 07.06.10
 (if (setq ss (ssget "_:L" '((0 . "POINT"))))
   ((lambda (i / p)
      (while (setq e (ssname ss (setq i (1+ i))))
        (if (vl-position (setq p (cdr (assoc 10 (entget e)))) lst)
          (entdel e)
          (setq lst (cons p lst))
        )
      )
    )
     -1
   )
 )
 (princ)
)

[fallen]

thanx for the code, but have u tried mine?, it takes lesser time about 10 secs for 34000 pts, if u can fix the error of mine i'll be so pleased.

thank u