ctdlc888 Posted March 15, 2012 Share Posted March 15, 2012 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. Quote Link to comment Share on other sites More sharing options...
SLW210 Posted March 15, 2012 Share Posted March 15, 2012 I moved this to the AutoLISP, Visual LISP & DCL forum. Quote Link to comment Share on other sites More sharing options...
ketxu Posted March 16, 2012 Share Posted March 16, 2012 Why don't you post your drawing, and what is the result that you want? Quote Link to comment Share on other sites More sharing options...
pBe Posted March 16, 2012 Share Posted March 16, 2012 (edited) ------->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: ::::: Edited March 17, 2012 by pBe Seek again/Select All points on current tab Quote Link to comment Share on other sites More sharing options...
David Bethel Posted March 16, 2012 Share Posted March 16, 2012 I'd try: [b][color=BLACK]([/color][/b]defun c:findpt [b][color=FUCHSIA]([/color][/b]/ fuzz ss bp ps en pp[b][color=FUCHSIA])[/color][/b] [color=#8b4513]; ts is global[/color] [b][color=FUCHSIA]([/color][/b]initget 7[b][color=FUCHSIA])[/color][/b] [b][color=FUCHSIA]([/color][/b]setq fuzz [b][color=NAVY]([/color][/b]getdist [color=#2f4f4f]"\nTolerance Distance: "[/color][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b] [b][color=FUCHSIA]([/color][/b]and [b][color=NAVY]([/color][/b]princ [color=#2f4f4f]"\nSelect Base Point: "[/color][b][color=NAVY])[/color][/b] [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]= [b][color=MAROON]([/color][/b]sslength ss[b][color=MAROON])[/color][/b] 1[b][color=NAVY])[/color][/b] [b][color=NAVY]([/color][/b]setq bp [b][color=MAROON]([/color][/b]cdr [b][color=GREEN]([/color][/b]assoc 10 [b][color=BLUE]([/color][/b]entget [b][color=RED]([/color][/b]ssname ss 0[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=NAVY]([/color][/b]setq ps [b][color=MAROON]([/color][/b]ssget [color=#2f4f4f]"_C"[/color] [b][color=GREEN]([/color][/b]list [b][color=BLUE]([/color][/b]- [b][color=RED]([/color][/b]car bp[b][color=RED])[/color][/b] fuzz[b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b]- [b][color=RED]([/color][/b]cadr bp[b][color=RED])[/color][/b] fuzz[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b] [b][color=GREEN]([/color][/b]list [b][color=BLUE]([/color][/b]+ [b][color=RED]([/color][/b]car bp[b][color=RED])[/color][/b] fuzz[b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b]+ [b][color=RED]([/color][/b]cadr bp[b][color=RED])[/color][/b] fuzz[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b] '[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]setq ts [b][color=MAROON]([/color][/b]ssadd[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b] [b][color=NAVY]([/color][/b]while [b][color=MAROON]([/color][/b]setq en [b][color=GREEN]([/color][/b]ssname ps 0[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]setq pp [b][color=GREEN]([/color][/b]cdr [b][color=BLUE]([/color][/b]assoc 10 [b][color=RED]([/color][/b]entget en[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]and [b][color=GREEN]([/color][/b]not [b][color=BLUE]([/color][/b]equal bp pp[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b] [b][color=GREEN]([/color][/b]<= [b][color=BLUE]([/color][/b]distance bp pp[b][color=BLUE])[/color][/b] fuzz[b][color=GREEN])[/color][/b] [b][color=GREEN]([/color][/b]ssadd en ts[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]ssdel en ps[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b] [b][color=NAVY]([/color][/b]prin1 [b][color=MAROON]([/color][/b]sslength ts[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b] [b][color=FUCHSIA]([/color][/b]prin1[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b] I don't think that the "W" ssget filter will return correct results. -David Also, please remember that point values are calculated in 3D Quote Link to comment Share on other sites More sharing options...
pBe Posted March 16, 2012 Share Posted March 16, 2012 You may have a point there David... I'll have a look-see. tnx Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted March 16, 2012 Share Posted March 16, 2012 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. Quote Link to comment Share on other sites More sharing options...
pBe Posted March 17, 2012 Share Posted March 17, 2012 Updated the code 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. Quote Link to comment Share on other sites More sharing options...
ctdlc888 Posted March 17, 2012 Author Share Posted March 17, 2012 Tanks good guys pBe,David,LeeMac i'll try them. @ketxu here's my prob.. http://www.4shared.com/photo/tTI3tUks/AcadDup.html Quote Link to comment Share on other sites More sharing options...
ctdlc888 Posted March 17, 2012 Author Share Posted March 17, 2012 (edited) @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 Edited March 18, 2012 by ctdlc888 Quote Link to comment Share on other sites More sharing options...
pBe Posted March 17, 2012 Share Posted March 17, 2012 (edited) Update Code at post #4 to include placement of duplicates on a separate layer. HTH EDIT: Scratch that code . Further testing shows using distance function is the way to go. unless i can find a way to force selection within circumference of a given radius. kudos to Lee and David Second attempt: (similar to Lee's approach) (defun c:Ptnum (/ cnt ss coll p) (vl-load-com) (if (and (setq cnt 0 coll nil fuzz (getdist "\nEmter Fuzz Value: ")) (ssget "_X" (list '(0 . "POINT") (cons 410 (getvar 'Ctab))))) (progn (vlax-for itm (setq ss (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object)))) (setq coll (cons (list (list (car (setq a (vlax-get itm 'Coordinates))) (cadr a)) itm) coll)) ) (vla-delete ss) (while (and (setq p (car coll)) (/= (length coll) 1)) (setq cnt (1+ cnt)) (foreach j coll (if (<= (distance (car p) (car j)) fuzz) (setq coll (vl-remove j coll)) ) (setq coll (vl-remove p coll)) )) ) ) (princ (strcat "\n" (itoa cnt) " Points Found")) (princ) ) Edited March 17, 2012 by pBe Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted March 17, 2012 Share Posted March 17, 2012 @LM.Can we have a prompt for input of tolerance and color of the new layer?if not too much of asking .thanks Here is a prompt for tolerance: (defun c:ptcount ( / a b d e f i s x y ) (setq d '(8 . "$DUPLICATE-POINTS$")) ;; Duplicate Points Layer (if (and (setq s (ssget "_X" '((0 . "POINT") (410 . "Model")))) (setq f (getdist "\nSpecify Tolerance: ")) ) (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) ) You can change the layer colour easily through the Layer Manager. Quote Link to comment Share on other sites More sharing options...
ctdlc888 Posted March 17, 2012 Author Share Posted March 17, 2012 yes sir pBe. some originals were added to duplicates layer.still i commend you Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.