I moved this to the AutoLISP, Visual LISP & DCL forum.
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.
“A narrow mind and a fat head invariably come on the same person” Zig Zigler
Why don't you post your drawing, and what is the result that you want?
<Limited testing>------->Further testing resulted in FAILURE to give accurate count
Code:(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: :::::
Last edited by pBe; 17th Mar 2012 at 11:35 am. Reason: Seek again/Select All points on current tab
Code:(defun c:findpt (/ fuzz ss bp ps en pp) ; ts is global (initget 7) (setq fuzz (getdist "\nTolerance Distance: ")) (and (princ "\nSelect Base Point: ") (setq ss (ssget '((0 . "POINT")))) (= (sslength ss) 1) (setq bp (cdr (assoc 10 (entget (ssname ss 0))))) (setq ps (ssget "_C" (list (- (car bp) fuzz) (- (cadr bp) fuzz)) (list (+ (car bp) fuzz) (+ (cadr bp) fuzz)) '((0 . "POINT")))) (setq ts (ssadd)) (while (setq en (ssname ps 0)) (setq pp (cdr (assoc 10 (entget en)))) (and (not (equal bp pp)) (<= (distance bp pp) fuzz) (ssadd en ts)) (ssdel en ps)) (prin1 (sslength ts))) (prin1))
I don't think that the "W" ssget filter will return correct results. -David
Also, please remember that point values are calculated in 3D
R12 (Dos) - A2K
You may have a point there David...
I'll have a look-see. tnx
Here is a 'Divide and Conquer' method:
Duplicate points will be placed on a separate layer.Code:(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) )
Updated the code [post #4]
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.
Registered forum members do not see this ad.
@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
Last edited by ctdlc888; 18th Mar 2012 at 02:54 am.