Topic: Find the same 2 points

[well20152016]

Code - Auto/Visual Lisp: [Select]

1. Known:
2. (
3. ((((1296.45 11052.0 -43133.8) 55) ((-1187.54 11032.5 -43133.8) 1) ((-1186.62 7937.77 -43133.8) 39) ((1299.61 7929.88 -43133.8) 90)) a)
4. ((((-2506.95 3496.12 0.0) 1) ((-2506.03 400.153 0.0) 39) ((-5506.95 3496.12 0.0) 21) ((-6506.95 7496.12 10.0) 44)) b)
5. ((((806.95 11052.0 3133.8) 90) ((6506.03 700.153 9.0) 39) ((8506.95 3496.12 8.0) 25) ((9506.95 7496.12 13.0) 34)) c)
6. )
7.  
8.  
9. Result:
10. (
11. ((((-1187.54 11032.5 -43133.8) a) ((-2506.95 3496.12    0.0) b) 1)      (((-1186.62 7937.77 -43133.8) a) ((-2506.03 400.153  0.0) b) 39 ))
12. ((((1299.61  7929.88 -43133.8) a) ((806.95 11052.0 3133.8) c) 90)     (((-1186.62 7937.77 -43133.8) a) ((6506.03   700.153 9.0) c) 39 ))
13. )
14.  
15.  

[roy_043]

Why is the 'known' list so complex?
Shouldn't the result look like this (see 'Added')?:

Code: [Select]

(
  (
    (
      ((-1187.54 11032.5 -43133.8) a)
      ((-2506.95 3496.12    0.0) b)
      1
    )
    (
      ((-1186.62 7937.77 -43133.8) a)
      ((-2506.03 400.153  0.0) b)
      39
    )
  )
  (
    (
      ((1299.61  7929.88 -43133.8) a)
      ((806.95 11052.0 3133.8) c)
      90
    )
    (
      ((-1186.62 7937.77 -43133.8) a)
      ((6506.03   700.153 9.0) c)
      39
    )
  )
  ( ; Added.
    (
      ((-2506.03 400.153  0.0) b)
      ((6506.03   700.153 9.0) c)
      39
    )
  )
)

[ahsattarian]

Try these two routines :

Code - Auto/Visual Lisp: [Select]

1. (defun overkill-points1 (ptlst1 fuzzy / ptlst2)
2.   (setq ptlst2 nil)
3.   (setq methodj1 2)
4.   (cond
5.     ((= methodj1 1) ;|  http://www.theswamp.org/index.php?topic=9042.msg567713#msg567713  |;
6.      (while (setq po (car ptlst1))
7.        (setq ptlst1
8.               (vl-remove-if
9.                 '(lambda (x) (and (equal (car po) (car x) fuzzy) (equal (cadr po) (cadr x) fuzzy)))
10.                 ptlst1
11.               )
12.        )
13.        (setq ptlst2 (append ptlst2 (list po)))
14.      )
15.     )
16.     ((= methodj1 2) ;|  http://www.theswamp.org/index.php?topic=9042.msg593203#msg593203  |;
17.      (setq ptlst1 (vl-sort ptlst1 (function (lambda (a b) (< (caddr a) (caddr b))))))
18.      (while (car ptlst1)
19.        (setq ptlst2 (cons (car ptlst1)
20.                           (vl-remove-if
21.                             (function (lambda (x) (equal (list (car x) (cadr x)) (list (caar ptlst1) (cadar ptlst1)) fuzzy)))
22.                             ptlst2
23.                           )
24.                     )
25.        )
26.        (setq ptlst1 (cdr ptlst1))
27.      )
28.     )
29.   )
30.   ptlst2
31. )
32. (defun overkill-points2 (ptlst1 fuzzy / ptlst2)
33.   (setq ptlst2 nil)
34.   (while (setq po (car ptlst1))
35.     (setq ptlst1 (cdr ptlst1))
36.     (setq ad 1)
37.     (foreach pt ptlst1
38.       (cond ((< (distance (list (car po) (cadr po)) (list (car pt) (cadr pt))) fuzzy) (setq ad 0)))
39.     )
40.     (cond ((= ad 1) (setq ptlst2 (append ptlst2 (list po)))))
41.   )
42. )