Topic: {Challenge}Get same zone boundary index set from the Matrix

[chlh_jd]

Hi, All 
I have a problem , to Get all same elements's zone boundary elements's index code set from the matrix list .
Any of the following forms of two adjacent elements considered Unicom , like 米

Code: [Select]

(( ...  ... ...)
  ...  1 1 1 ...
  ...   1 1 1 ...
  ...   1 1 1 ...))
e.g.

Code: [Select]

((nil 1 1 1 1 nil 0 2 2)
 (nil 1 1 1 1 1 0 nil 2)
 (nil nil 1 1 1 1 1 nil nil)
 (nil nil 0 1 2  3 1 0 nil)
)
fuction to cal (item = 1 )'s zone boundary , the result is ( ((0 1) (1 1) (2 2) (3 3)  (2 4) (2 5) (3 6) (2 6) (1 5) (0 4) (0 3) (0 2)) ...)
Here's item=1 has one zoon just supposed , Function have to cal all zones just like the nil item .

This function is very often encountered (e.g. used in Vector graphics), so I dubbed the "challenge" the beginning of .

[ElpanovEvgeniy]

I could not understand the task ...
publish a simple example with the call and response ...

graphics are welcome ...

[chlh_jd]

I could not understand the task ...
publish a simple example with the call and response ...
graphics are welcome ...

Sorry for my poor English .
Perhaps the function just like the Figure .

Code: [Select]

(setq l ((0 0 0 0 0 0 1 1 1 1 1 1 1 1 1)
  (0 0 0 0 0 1 1 1 1 2 1 1 1 1 1)
  (0 0 0 0 1 1 1 1 1 2 2 2 2 2 2)
  (0 0 0 0 1 1 1 1 1 1 2 2 2 2 2)
  (0 0 0 0 1 1 1 1 1 1 2 2 2 2 2)
  (1 1 0 1 1 1 1 1 1 1 2 2 2 2 2)
  (1 1 1 1 0 1 1 1 2 2 2 2 1 1 1)
  (0 1 0 0 0 1 1 1 2 2 1 1 1 1 1)
  (1 1 0 1 1 1 1 1 1 1 1 1 1 1 1)
  (1 1 1 1 1 1 1 1 1 2 1 1 1 1 1)
  (1 1 1 1 1 1 1 1 1 2 2 2 1 1 1)
  (1 1 1 1 1 1 1 1 1 2 2 1 1 1 1)
  (1 1 1 1 1 1 1 1 1 2 2 1 1 1 1)
  (1 1 1 1 1 1 1 1 1 2 2 1 1 1 2)
  (1 1 1 1 1 1 1 1 2 2 2 2 2 2 2)
  (1 1 1 1 1 1 1 1 1 2 2 2 2 2 1)
  (1 1 1 1 1 1 1 1 1 1 2 2 2 1 1)))
;;Cal same colour zone
(foo l) --->
'(
(2 ((0 0) (1 0) (2 0) (3 0) (4 0) (5 0) (4 1) (3 2) (3 3) (3 4) (2 5) (1 4) (0 4) (0 3) (0 2) (0 1) (0 0))
   ((4 6) (4 7) (2 7) (2 8)))
(1 ((6 0) (7 0) (8 0) (8 1) (8 2) (9 3) (9 4) (9 5) (8 5) (7 6) (7 7) (8 8) (8 9) (8 10) (8 11) (8 12) (8 13)
    (7 14) (8 15) (9 16) (8 16) (7 16) (6 16) (5 16) (4 16) (3 16) (2 16) (1 16) (0 16) (0 15) (0 14) (0 13)
    (0 12) (0 11) (0 10) (0 9) (0 8) (0 7) (0 6) (0 5) (1 5) (1 6) (1 7) (1 8) (1 9) (2 9) (3 8) (4 8) (5 7)
    (5 6) (4 5) (4 4) (4 3) (4 2) (5 1) (6 0))
   ((9 0) (10 0) (11 0) (12 0) (13 0) (14 0) (14 1) (13 1) (12 1) (11 1) (10 1) (9 0))
   ((12 6) (13 6) (14 6) (14 7) (14 8) (14 9) (14 10) (14 11) (14 12) (13 13) (12 13) (11 13) (11 12) (11 11)
   (12 10) (11 9) (10 9) (9 8) (10 7) (11 7) (12 6))
   ((14 15) (14 16) (13 16) (14 15)))
(0 ((9 1) (10 2) (11 2) (12 2) (13 2) (14 2) (14 3) (14 4) (14 5) (13 5) (12 5) (11 6) (10 6) (9 7) (8 7)
  (8 6) (9 6) (10 5) (10 4) (10 3) (9 2) (9 1))
   ((14 14) (14 13) (13 14) (12 14) (10 14) (10 13) (10 12) (10 11) (11 10) (10 10) (9 9) (9 10) (9 11)
    (9 12) (9 13) (8 14) (9 15) (10 16) (12 16) (13 15) (14 14))))


[chlh_jd]

To solve Vector Graphics must add other conditions , however , here we just suppose to cal the same colore zone , If only one small square , see as not can be link to other squares .

[chlh_jd]

I found my English is too poor , I can't explain my right thoughts .
I post the result picture I want .
So the function is to cal the same colore zone's indexs of the colore zone matrix .

[ElpanovEvgeniy]

problem is similar to search geodesic contours...

Code - Auto/Visual Lisp: [Select]

1. (setq l '((0 0 0 0 0 0 1 1 1 1 1 1 1 1 1)
2.           (0 0 0 0 0 1 1 1 1 2 1 1 1 1 1)
3.           (0 0 0 0 1 1 1 1 1 2 2 2 2 2 2)
4.           (0 0 0 0 1 1 1 1 1 1 2 2 2 2 2)
5.           (0 0 0 0 1 1 1 1 1 1 2 2 2 2 2)
6.           (1 1 0 1 1 1 1 1 1 1 2 2 2 2 2)
7.           (1 1 1 1 0 1 1 1 2 2 2 2 1 1 1)
8.           (0 1 0 0 0 1 1 1 2 2 1 1 1 1 1)
9.           (1 1 0 1 1 1 1 1 1 1 1 1 1 1 1)
10.           (1 1 1 1 1 1 1 1 1 2 1 1 1 1 1)
11.           (1 1 1 1 1 1 1 1 1 2 2 2 1 1 1)
12.           (1 1 1 1 1 1 1 1 1 2 2 1 1 1 1)
13.           (1 1 1 1 1 1 1 1 1 2 2 1 1 1 1)
14.           (1 1 1 1 1 1 1 1 1 2 2 1 1 1 2)
15.           (1 1 1 1 1 1 1 1 2 2 2 2 2 2 2)
16.           (1 1 1 1 1 1 1 1 1 2 2 2 2 2 1)
17.           (1 1 1 1 1 1 1 1 1 1 2 2 2 1 1)
18.          )
19.       x 0
20.       y -1
21. )
22. (mapcar (function (lambda (a b)
23.                     (setq x 0 y (1+ y))
24.                     (mapcar (function (lambda (a b c d)
25.                                         (entmakex (list '(0 . "3DFACE")
26.                                                         '(100 . "AcDbEntity")
27.                                                         '(67 . 0)
28.                                                         '(410 . "Model")
29.                                                         '(100 . "AcDbFace")
30.                                                         (list 10 x y a)
31.                                                         (list 11 (1+ x) y b)
32.                                                         (list 12 (1+ x) (1+ y) d)
33.                                                         (list 13 x (1+ y) c)
34.                                                         '(70 . 0)
35.                                                   )
36.                                         )
37.                                         (setq x (1+ x))
38.                                       )
39.                             )
40.                             a
41.                             (cdr a)
42.                             b
43.                             (cdr b)
44.                     )
45.                   )
46.         )
47.         l
48.         (cdr l)
49. )

[chlh_jd]

problem is similar to search geodesic contours...

Thanks Evgeniy !
Good idea !

[ElpanovEvgeniy]

Code - Auto/Visual Lisp: [Select]

1. (defun eea-geodesic-contours-TheSwamp (l / X Y)
2.   ;; by ElpanovEvgeniy
3.   ;;(eea-geodesic-contours-TheSwamp l)
4.   (defun min-max (a b c) (list (min a b c) (max a b c)))
5.   (defun fix-z (p z) (list (car p) (cadr p) z))
6.   (setq y -1.
7.         l (apply (function append)
8.                  (mapcar (function
9.                            (lambda (a b)
10.                              (setq x -1.
11.                                    y (1+ y)
12.                              )
13.                              (apply (function append)
14.                                     (mapcar (function
15.                                               (lambda (a b c d / z)
16.                                                 ;;(setq a (caar l) b (cadar l) c(caadr l) d(cadadr l))
17.                                                 (setq x (1+ x)
18.                                                       z (/ (+ a b c d) 4.)
19.                                                 )
20.                                                 (list (list (min-max a b z) (list x y a) (list (1+ x) y b) (list (+ x 0.5) (+ y 0.5) z))
21.                                                       (list (min-max a c z) (list x y a) (list x (1+ y) c) (list (+ x 0.5) (+ y 0.5) z))
22.                                                       (list (min-max b d z) (list (1+ x) y b) (list (1+ x) (1+ y) d) (list (+ x 0.5) (+ y 0.5) z))
23.                                                       (list (min-max c d z) (list x (1+ y) c) (list (1+ x) (1+ y) d) (list (+ x 0.5) (+ y 0.5) z))
24.                                                 )
25.                                               )
26.                                             )
27.                                             a
28.                                             (cdr a)
29.                                             b
30.                                             (cdr b)
31.                                     )
32.                              )
33.                            )
34.                          )
35.                          l
36.                          (cdr l)
37.                  )
38.           )
39.   )
40.   (foreach z '(0.5 1.5 2.5)
41.     (foreach tr l
42.       (if (and (<= (caar tr) z (cadar tr))
43.                (cdr (setq tr (vl-remove nil
44.                                         (list (inters (nth 1 tr) (nth 2 tr) (fix-z (nth 1 tr) z) (fix-z (nth 2 tr) z))
45.                                               (inters (nth 2 tr) (nth 3 tr) (fix-z (nth 2 tr) z) (fix-z (nth 3 tr) z))
46.                                               (inters (nth 1 tr) (nth 3 tr) (fix-z (nth 1 tr) z) (fix-z (nth 3 tr) z))
47.                                         )
48.                              )
49.                     )
50.                )
51.           )
52.         (entmakex (list '(0 . "line") (cons 62 (fix (* z 10))) (cons 10 (car tr)) (cons 11 (cadr tr))))
53.       )
54.     )
55.   )
56.   (princ)
57. )

Code: [Select]

(setq l '((0 0 0 0 0 0 1 1 1 1 1 1 1 1 1)
          (0 0 0 0 0 1 1 1 1 2 1 1 1 1 1)
          (0 0 0 0 1 1 1 1 1 2 2 2 2 2 2)
          (0 0 0 0 1 1 1 1 1 1 2 2 2 2 2)
          (0 0 0 0 1 1 1 1 1 1 2 2 2 2 2)
          (1 1 0 1 1 1 1 1 1 1 2 2 2 2 2)
          (1 1 1 1 0 1 1 1 2 2 2 2 1 1 1)
          (0 1 0 0 0 1 1 1 2 2 1 1 1 1 1)
          (1 1 0 1 1 1 1 1 1 1 1 1 1 1 1)
          (1 1 1 1 1 1 1 1 1 2 1 1 1 1 1)
          (1 1 1 1 1 1 1 1 1 2 2 2 1 1 1)
          (1 1 1 1 1 1 1 1 1 2 2 1 1 1 1)
          (1 1 1 1 1 1 1 1 1 2 2 1 1 1 1)
          (1 1 1 1 1 1 1 1 1 2 2 1 1 1 2)
          (1 1 1 1 1 1 1 1 2 2 2 2 2 2 2)
          (1 1 1 1 1 1 1 1 1 2 2 2 2 2 1)
          (1 1 1 1 1 1 1 1 1 1 2 2 2 1 1)
         )
      )
(eea-geodesic-contours-TheSwamp l)


[ElpanovEvgeniy]

small addition to supplementary contours ... 

Code - Auto/Visual Lisp: [Select]

1. (defun eea-geodesic-contours-TheSwamp (l lst-z / X Y)
2.   ;; by ElpanovEvgeniy
3.   ;;(eea-geodesic-contours-TheSwamp l '(0.5 1.5))
4.   (defun min-max (a b c) (list (min a b c) (max a b c)))
5.   (defun fix-z (p z) (list (car p) (cadr p) z))
6.   (setq y -1.
7.         l (apply (function append)
8.                  (mapcar (function
9.                            (lambda (a b)
10.                              (setq x -1.
11.                                    y (1+ y)
12.                              )
13.                              (apply (function append)
14.                                     (mapcar (function
15.                                               (lambda (a b c d / z)
16.                                                 ;;(setq a (caar l) b (cadar l) c(caadr l) d(cadadr l))
17.                                                 (setq x (1+ x)
18.                                                       z (/ (+ a b c d) 4.)
19.                                                 )
20.                                                 (list (list (min-max a b z) (list x y a) (list (1+ x) y b) (list (+ x 0.5) (+ y 0.5) z))
21.                                                       (list (min-max a c z) (list x y a) (list x (1+ y) c) (list (+ x 0.5) (+ y 0.5) z))
22.                                                       (list (min-max b d z) (list (1+ x) y b) (list (1+ x) (1+ y) d) (list (+ x 0.5) (+ y 0.5) z))
23.                                                       (list (min-max c d z) (list x (1+ y) c) (list (1+ x) (1+ y) d) (list (+ x 0.5) (+ y 0.5) z))
24.                                                 )
25.                                               )
26.                                             )
27.                                             a
28.                                             (cdr a)
29.                                             b
30.                                             (cdr b)
31.                                     )
32.                              )
33.                            )
34.                          )
35.                          l
36.                          (cdr l)
37.                  )
38.           )
39.   )
40.   (foreach z lst-z
41.     (foreach tr l
42.       (if (and (<= (caar tr) z (cadar tr))
43.                (cdr (setq tr (vl-remove nil
44.                                         (list (inters (nth 1 tr) (nth 2 tr) (fix-z (nth 1 tr) z) (fix-z (nth 2 tr) z))
45.                                               (inters (nth 2 tr) (nth 3 tr) (fix-z (nth 2 tr) z) (fix-z (nth 3 tr) z))
46.                                               (inters (nth 1 tr) (nth 3 tr) (fix-z (nth 1 tr) z) (fix-z (nth 3 tr) z))
47.                                         )
48.                              )
49.                     )
50.                )
51.           )
52.         (entmakex (list '(0 . "line") (cons 62 (fix (* z 10))) (cons 10 (car tr)) (cons 11 (cadr tr))))
53.       )
54.     )
55.   )
56.   (princ)
57. )

Code: [Select]

(eea-geodesic-contours-TheSwamp l '(0.1 0.3 0.5 0.7 0.9 1.1 1.3 1.5 1.7 1.9))

[dgorsman]

There's probably some good information on edge detection in the image processing field that would be directly applicable.

[chlh_jd]

Evgeniy's allways excellent ! 
I have to spend a lot of time to understand your implementation ideas and source code .

[ElpanovEvgeniy]

added display of all triangles - will now be more clear, the algorithm of the program...

Code - Auto/Visual Lisp: [Select]

1. (eea-geodesic-contours-TheSwamp l '(0.0 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 1.0 1.1 1.2 1.3 1.4 1.5 1.6 1.7 1.8 1.9 2.0))

Code - Auto/Visual Lisp: [Select]

1. (defun eea-geodesic-contours-TheSwamp (l lst-z / X Y)
2.   ;; by ElpanovEvgeniy
3.   ;;(eea-geodesic-contours-TheSwamp l '(0.5 1.5))
4.   ;; last edit 26.09.2012
5.   (defun min-max (a b c) (list (min a b c) (max a b c)))
6.   (defun fix-z (p z) (list (car p) (cadr p) z))
7.   (setq y -1.
8.         l (apply (function append)
9.                  (mapcar (function
10.                            (lambda (a b)
11.                              (setq x -1.
12.                                    y (1+ y)
13.                              )
14.                              (apply (function append)
15.                                     (mapcar (function
16.                                               (lambda (a b c d / z)
17.                                                 (setq x (1+ x)
18.                                                       z (/ (+ a b c d) 4.)
19.                                                 )
20.                                                 (list (list (min-max a b z) (list x y a) (list (1+ x) y b) (list (+ x 0.5) (+ y 0.5) z))
21.                                                       (list (min-max a c z) (list x y a) (list x (1+ y) c) (list (+ x 0.5) (+ y 0.5) z))
22.                                                       (list (min-max b d z) (list (1+ x) y b) (list (1+ x) (1+ y) d) (list (+ x 0.5) (+ y 0.5) z))
23.                                                       (list (min-max c d z) (list x (1+ y) c) (list (1+ x) (1+ y) d) (list (+ x 0.5) (+ y 0.5) z))
24.                                                 )
25.                                               )
26.                                             )
27.                                             a
28.                                             (cdr a)
29.                                             b
30.                                             (cdr b)
31.                                     )
32.                              )
33.                            )
34.                          )
35.                          l
36.                          (cdr l)
37.                  )
38.           )
39.   )
40.   (foreach tr l
41.     (entmakex (list '(0 . "3DFACE")
42.                     '(100 . "AcDbEntity")
43.                     '(62 . 251)
44.                     '(67 . 0)
45.                     '(410 . "Model")
46.                     '(100 . "AcDbFace")
47.                     (cons 10 (cadr tr))
48.                     (cons 11 (caddr tr))
49.                     (cons 12 (cadddr tr))
50.                     (cons 13 (cadddr tr))
51.                     '(70 . 0)
52.               )
53.     )
54.   )
55.   (foreach z lst-z
56.     (foreach tr l
57.       (if (and (<= (caar tr) z (cadar tr))
58.                (cdr (setq tr (vl-remove nil
59.                                         (list (inters (nth 1 tr) (nth 2 tr) (fix-z (nth 1 tr) z) (fix-z (nth 2 tr) z))
60.                                               (inters (nth 2 tr) (nth 3 tr) (fix-z (nth 2 tr) z) (fix-z (nth 3 tr) z))
61.                                               (inters (nth 1 tr) (nth 3 tr) (fix-z (nth 1 tr) z) (fix-z (nth 3 tr) z))
62.                                         )
63.                              )
64.                     )
65.                )
66.           )
67.         (entmakex (list '(0 . "line")
68.                         (cons 62 (atoi (rtos (* (- 2. z) 100) 2 0)))
69.                         (cons 10 (car tr))
70.                         (cons 11 (cadr tr))
71.                   )
72.         )
73.       )
74.     )
75.   )
76.   (princ)
77. )

[chlh_jd]

So woderful for Height contours , Evgeniy.
After learn your codes , I write my first codes .

Code: [Select]

(setq l '((0 0 0 0 0 0 1 1 1 1 1 1 1 1 1)
  (0 0 0 0 0 1 1 1 1 2 1 1 1 1 1)
  (0 0 0 0 1 1 1 1 1 2 2 2 2 2 2)
  (0 0 0 0 1 1 1 1 1 1 2 2 2 2 2)
  (0 0 0 0 1 1 1 1 1 1 2 2 2 2 2)
  (1 1 0 1 1 1 1 1 1 1 2 2 2 2 2)
  (1 1 1 1 0 1 1 1 2 2 2 2 1 1 1)
  (0 1 0 0 0 1 1 1 2 2 1 1 1 1 1)
  (1 1 0 1 1 1 1 1 1 1 1 1 1 1 1)
  (1 1 1 1 1 1 1 1 1 2 1 1 1 1 1)
  (1 1 1 1 1 1 1 1 1 2 2 2 1 1 1)
  (1 1 1 1 1 1 1 1 1 2 2 1 1 1 1)
  (1 1 1 1 1 1 1 1 1 2 2 1 1 1 1)
  (1 1 1 1 1 1 1 1 1 2 2 1 1 1 2)
  (1 1 1 1 1 1 1 1 2 2 2 2 2 2 2)
  (1 1 1 1 1 1 1 1 1 2 2 2 2 2 1)
  (1 1 1 1 1 1 1 1 1 1 2 2 2 1 1)))
(defun test  (l / f1 f2 y x lst l1 a b c e res ss)
  (defun f1  (a l)
    (cond ((not l) nil)
  ((equal a (caar l))
   (cons 0 (car l)))
  ((equal a (cadar l))
   (cons 1 (car l)))
  (t (f1 a (cdr l)))
  ))
  (defun f2  (l / r p p0 p1)
    (setq r (list (car l))
  l (cdr l))
    (while (cadr l)
      (setq p  (car l)
    p1 (cadr l)
    l  (cdr l)
    p0 (car r))
      (if (not (or (= (car p0) (car p) (car p1))
   (= (cadr p0) (cadr p) (cadr p1))))
(setq r (cons p r))))
    (cons (car l) r))
  (setq y -0.5)
  (mapcar (function (lambda (a b)
      (setq y (1+ y)
    x -1.5)
      (mapcar (function (lambda (a b)
  (setq x (1+ x))
  (if (/= a b)
    (setq lst
   (cons (list (list x y) (list (1+ x) y))
lst))
    )))
      a
      b)))
  l
  (cdr l))
  (setq y -1.5)
  (mapcar (function (lambda (a)
      (setq y (1+ y)
    x -0.5)
      (mapcar (function (lambda (a b)
  (setq x (1+ x))
  (if (/= a b)
    (setq lst
   (cons (list (list x y) (list x (1+ y)))
lst))
    )))
      a
      (cdr a))))
  l
  )
  ;|
  (setq lst (vl-sort lst (function (lambda (a b)
     (if (equal (car a) (car b))
       (< (cadadr a) (cadadr b))
       (if (equal (cadar a) (cadar b))
(< (caar a) (caar b))
(< (cadar a) (cadar b))))))
     ))  |;
  (while lst
    (setq a   (car lst)
  lst (cdr lst))
    (while (setq b (f1 (car a) lst))
      (setq lst (vl-remove (cdr b) lst)
    a (cons (if (zerop (car b))
(caddr b)
(cadr b))
      a)))
    (setq a (reverse a))
    (while (setq b (f1 (car a) lst))
      (setq lst (vl-remove (cdr b) lst)
    a (cons (if (zerop (car b))
(caddr b)
(cadr b))
      a)))
    (setq a (f2 a))
    (setq res (cons a res)))
  (setq ss (ssadd))
  (foreach a  res
    (if (setq e (entmakex
  (append
    (list (cons 0 "LWPOLYLINE")
  (cons 100 "AcDbEntity")
  (cons 100 "AcDbPolyline")
  (cons 90 (length a))
  )
    (mapcar (function (lambda (x) (cons 10 x))) a)
    (list (cons 70 0) (cons 62 6))
    )))
      (setq ss (ssadd e ss))))
  (vl-catch-all-apply
    (function vl-cmdf)
    (list "_.Pedit" "M" ss "" "S" ""))
  (princ)
  )
Use Test fun : (Test l) ---->

[chlh_jd]

Try this List in Testlst.lsp , I don't get the result .

[ElpanovEvgeniy]

Code - Auto/Visual Lisp: [Select]

1. (eea-geodesic-contours-TheSwamp l '(0.25 0.5 0.75 1.0 1.25 1.5 1.75 2.0 2.25 2.5 2.75 3.0))
2. (defun eea-geodesic-contours-TheSwamp (l lst-z / X Y)
3.   ;; by ElpanovEvgeniy
4.   ;;(eea-geodesic-contours-TheSwamp l '(0.5 1.5 2.5))
5.   ;; last edit 26.09.2012
6.   (defun min-max (a b c) (list (min a b c) (max a b c)))
7.   (defun fix-z (p z) (list (car p) (cadr p) z))
8.   (setq y -1.
9.         l (apply (function append)
10.                  (mapcar (function
11.                            (lambda (a b)
12.                              (setq x -1.
13.                                    y (1+ y)
14.                              )
15.                              (apply (function append)
16.                                     (mapcar (function
17.                                               (lambda (a b c d / z)
18.                                                 (setq x (1+ x)
19.                                                       z (/ (+ a b c d) 4.)
20.                                                 )
21.                                                 (list (list (min-max a b z) (list x y a) (list (1+ x) y b) (list (+ x 0.5) (+ y 0.5) z))
22.                                                       (list (min-max a c z) (list x y a) (list x (1+ y) c) (list (+ x 0.5) (+ y 0.5) z))
23.                                                       (list (min-max b d z) (list (1+ x) y b) (list (1+ x) (1+ y) d) (list (+ x 0.5) (+ y 0.5) z))
24.                                                       (list (min-max c d z) (list x (1+ y) c) (list (1+ x) (1+ y) d) (list (+ x 0.5) (+ y 0.5) z))
25.                                                 )
26.                                               )
27.                                             )
28.                                             a
29.                                             (cdr a)
30.                                             b
31.                                             (cdr b)
32.                                     )
33.                              )
34.                            )
35.                          )
36.                          l
37.                          (cdr l)
38.                  )
39.           )
40.   )
41. ;;;  (foreach tr l
42. ;;;    (entmakex (list '(0 . "3DFACE")
43. ;;;                    '(100 . "AcDbEntity")
44. ;;;                    '(62 . 251)
45. ;;;                    '(67 . 0)
46. ;;;                    '(410 . "Model")
47. ;;;                    '(100 . "AcDbFace")
48. ;;;                    (cons 10 (cadr tr))
49. ;;;                    (cons 11 (caddr tr))
50. ;;;                    (cons 12 (cadddr tr))
51. ;;;                    (cons 13 (cadddr tr))
52. ;;;                    '(70 . 0)
53. ;;;              )
54. ;;;    )
55. ;;;  )
56.   (foreach z lst-z
57.     ;;(setq z 2.5)
58.     (foreach tr l
59.       (if (and (<= (caar tr) z (cadar tr))
60.                (cdr (setq tr (vl-remove nil
61.                                         (list (inters (nth 1 tr) (nth 2 tr) (fix-z (nth 1 tr) z) (fix-z (nth 2 tr) z))
62.                                               (inters (nth 2 tr) (nth 3 tr) (fix-z (nth 2 tr) z) (fix-z (nth 3 tr) z))
63.                                               (inters (nth 1 tr) (nth 3 tr) (fix-z (nth 1 tr) z) (fix-z (nth 3 tr) z))
64.                                         )
65.                              )
66.                     )
67.                )
68.           )
69.         (entmakex (list '(0 . "line")
70.                         (cons 8 (rtos z 2 1))
71.                         (cons 10 (car tr))
72.                         (cons 11 (cadr tr))
73.                   )
74.         )
75.       )
76.     )
77.   )
78.   (princ)
79. )