Topic: =>[Challenge]<= Nested rectangles

[Jeremy]

Thought we needed a fun task to do. Consider the illustration of rectangles within rectangles. We will assume that each rectangle is a dynamic block that has been stretched out as needed. We will also assume that all rectangles are drawn so that they do not intersect or touch each other. I want the user to be able to select all of the rectangles and get nested parentheses indicating the nesting relationship between the rectangles. The ordering will be determined going from left to right and top to bottom. Let the integers represent the enames of the rectangles. I want to get back a list like this

(1 (2)(3 (4)(5))(6 (7 (8 ))))

where each pair of parentheses represents one of the rectangles and the integers are the enames of the appropriate rectangles.

[Jeremy]

Sorry folks, meant to post this in the general section but forgot that I wasn't there before I hit the button. Could a moderator move this please?

[Lee Mac]

Here is my attempt:

Code - Auto/Visual Lisp: [Select]

1. (defun c:rord ( / _inside-p _massoc _process ent inc itm lst ref sel sub tmp vtl )
2.  
3.     (defun _inside-p ( ll1 ur1 ll2 ur2 )
4.         (apply 'and (mapcar '<= ll2 ll1 ur1 ur2))
5.     )
6.  
7.     (defun _massoc ( key lst )
8.         (if (setq itm (assoc key lst))
9.             (cons (cdr itm) (_massoc key (cdr (member itm lst))))
10.         )
11.     )
12.  
13.     (defun _process ( lst ref / itm nst out )
14.         (while (setq itm (car lst))
15.             (setq lst (cdr lst))
16.             (if (setq nst (cdr (assoc itm ref)))
17.                 (setq out (cons (cons itm (_process nst ref)) out)
18.                       lst (vl-remove-if '(lambda ( x ) (member x nst)) lst)
19.                 )
20.                 (setq out (cons itm out))
21.             )
22.         )
23.         (reverse out)
24.     )
25.    
26.     (if (setq sel (ssget '((0 . "LWPOLYLINE") (90 . 4) (-4 . "&=") (70 . 1))))
27.         (progn
28.             (repeat (setq inc (sslength sel))
29.                 (setq ent (ssname sel (setq inc (1- inc)))
30.                       vtl (_massoc 10 (entget ent))
31.                       tmp (cons (cons ent (mapcar '(lambda ( x ) (apply 'mapcar (cons x vtl))) '(min max))) tmp)
32.                       lst (cons ent lst)
33.                 )
34.             )
35.             (foreach x1 tmp
36.                 (foreach x2 (vl-remove x1 tmp)
37.                     (if (apply '_inside-p (append (cdr x2) (cdr x1)))
38.                         (setq sub (cons (car x2) sub))
39.                     )
40.                 )
41.                 (setq ref (cons (cons (car x1) sub) ref)
42.                       sub nil
43.                 )
44.             )
45.             (_process (vl-sort lst '(lambda ( a b ) (> (length (assoc a ref)) (length (assoc b ref))))) ref)
46.         )
47.     )
48. )

[ElpanovEvgeniy]

my version:

Code - Auto/Visual Lisp: [Select]

1. (defun eea-test (/ f l)
2.   (defun f (l a b c)
3.     (cond ((not l)
4.            (vl-remove nil
5.                       (cons (if b
6.                               (cons (last a) (f (cdr (reverse b)) (last b) nil nil))
7.                               (cddr a)
8.                             )
9.                             (if c
10.                               (f (cdr (reverse c)) (last c) nil nil)
11.                             )
12.                       )
13.            )
14.           )
15.           ((vl-every (function <=) (car a) (caar l) (cadr a)) (f (cdr l) a (cons (car l) b) c))
16.           ((f (cdr l) a b (cons (car l) c)))
17.     )
18.   )
19.   (if (setq l (ssget '((0 . "LWPOLYLINE") (90 . 4) (-4 . "&=") (70 . 1))))
20.     (progn (setq l (vl-sort (mapcar (function (lambda (a) (append (acet-geom-extents a) (list a))))
21.                                     (vl-remove-if (function listp) (mapcar (function cadr) (ssnamex l)))
22.                             )
23.                             (function (lambda (a b) (<= (caar a) (caar b))))
24.                    )
25.            )
26.            (f (cdr l) (car l) nil nil)
27.     )
28.   )
29. )

[ElpanovEvgeniy]

Here is my attempt:

Code - Auto/Visual Lisp: [Select]

1. (defun c:rord ( / _inside-p _massoc _process ent inc itm lst ref sel sub tmp vtl )
2. ...

Hi Lee!
Your version gives replays for nested entities... 

[ElpanovEvgeniy]

optimized my version:

Code - Auto/Visual Lisp: [Select]

1. (defun eea-test-1 (/ f l)
2.   (defun f (l a b c)
3.     (cond ((not l)
4.            (cons (if b
5.                    (cons (last a) (f (cdr (reverse b)) (last b) nil nil))
6.                    (cddr a)
7.                  )
8.                  (if c
9.                    (f (cdr (reverse c)) (last c) nil nil)
10.                  )
11.            )
12.           )
13.           ((vl-every (function <=) (car a) (caar l) (cadr a)) (f (cdr l) a (cons (car l) b) c))
14.           ((f (cdr l) a b (cons (car l) c)))
15.     )
16.   )
17.   (if (setq l (ssget '((0 . "LWPOLYLINE") (90 . 4) (-4 . "&=") (70 . 1))))
18.     (progn (setq l (vl-sort (mapcar (function (lambda (a) (reverse (cons a (acet-geom-extents a)))))
19.                                     (vl-remove-if (function listp) (mapcar (function cadr) (ssnamex l)))
20.                             )
21.                             (function (lambda (a b) (<= (caar a) (caar b))))
22.                    )
23.            )
24.            (f (cdr l) (car l) nil nil)
25.     )
26.   )
27. )

ps. Why, this topic in the section "CAD General", and not "AutoLISP (Vanilla / Visual)"?

[Lee Mac]

my version:

Code - Auto/Visual Lisp: [Select]

1. (defun f (l a b c)
2.     (cond ((not l)
3.            (vl-remove nil
4.                       (cons (if b
5.                               (cons (last a) (f (cdr (reverse b)) (last b) nil nil))
6.                               (cddr a)
7.                             )
8.                             (if c
9.                               (f (cdr (reverse c)) (last c) nil nil)
10.                             )
11.                       )
12.            )
13.           )
14.           ((vl-every (function <=) (car a) (caar l) (cadr a)) (f (cdr l) a (cons (car l) b) c))
15.           ((f (cdr l) a b (cons (car l) c)))
16.     )
17.   )

Superb method Evgeniy!
The recursion technique reminds me of this. 

Here is my attempt:

Code - Auto/Visual Lisp: [Select]

1. (defun c:rord ( / _inside-p _massoc _process ent inc itm lst ref sel sub tmp vtl )
2. ...

Hi Lee!
Your version gives replays for nested entities... 

It worked in all of my tests, but I agree that the method is not as robust as yours.

optimized my version:

Careful Evgeniy:

Code - Auto/Visual Lisp: [Select]

1. (reverse (cons a (acet-geom-extents a))) =/= (append (acet-geom-extents a) (list a))

Also, since you are aiming for optimisation, why use:

Code - Auto/Visual Lisp: [Select]

1. (vl-remove-if (function listp) (mapcar (function cadr) (ssnamex l)))

ssnamex is known to be very slow...

[ElpanovEvgeniy]

It worked in all of my tests, but I agree that the method is not as robust as yours.

Draw three rectangles, first inside, then outside (see attachments)...

Code: [Select]

((<Entity name: 7ffffce5810> <Entity name: 7ffffce5760> (<Entity name: 7ffffce5800> <Entity name: 7ffffce5760>)))

[Lee Mac]

It worked in all of my tests, but I agree that the method is not as robust as yours.

Draw three rectangles, first inside, then outside (see attachments)...

Code: [Select]

((<Entity name: 7ffffce5810> <Entity name: 7ffffce5760> (<Entity name: 7ffffce5800> <Entity name: 7ffffce5760>)))

Thanks!

This should fix the problem, but it is ugly compared with your solution:

Code - Auto/Visual Lisp: [Select]

1. (defun c:rord ( / _inside-p _massoc _process _sort enx han inc itm lst ref sel sub tmp vtl )
2.  
3.     (defun _inside-p ( ll1 ur1 ll2 ur2 )
4.         (apply 'and (mapcar '<= ll2 ll1 ur1 ur2))
5.     )
6.  
7.     (defun _massoc ( key lst )
8.         (if (setq itm (assoc key lst))
9.             (cons (cdr itm) (_massoc key (cdr (member itm lst))))
10.         )
11.     )
12.  
13.     (defun _process ( lst ref / itm nst out )
14.         (while (setq itm (car lst))
15.             (setq lst (cdr lst))
16.             (if (setq nst (cdr (assoc itm ref)))
17.                 (setq out (cons (cons itm (_process (_sort nst ref) ref)) out)
18.                       lst (vl-remove-if '(lambda ( x ) (member x nst)) lst)
19.                 )
20.                 (setq out (cons itm out))
21.             )
22.         )
23.         (reverse out)
24.     )
25.  
26.     (defun _sort ( lst ref )
27.         (vl-sort lst '(lambda ( a b ) (> (length (assoc a ref)) (length (assoc b ref)))))
28.     )      
29.  
30.     (if (setq sel (ssget '((0 . "LWPOLYLINE") (90 . 4) (-4 . "&=") (70 . 1))))
31.         (progn
32.             (repeat (setq inc (sslength sel))
33.                 (setq enx (entget (ssname sel (setq inc (1- inc))))
34.                       vtl (_massoc 10 enx)
35.                       han (cdr (assoc 5 enx))
36.                       tmp (cons (cons han (mapcar '(lambda ( x ) (apply 'mapcar (cons x vtl))) '(min max))) tmp)
37.                       lst (cons han lst)
38.                 )
39.             )
40.             (foreach x1 tmp
41.                 (foreach x2 (vl-remove x1 tmp)
42.                     (if (apply '_inside-p (append (cdr x2) (cdr x1)))
43.                         (setq sub (cons (car x2) sub))
44.                     )
45.                 )
46.                 (setq ref (cons (cons (car x1) sub) ref)
47.                       sub nil
48.                 )
49.             )
50.             (_process (_sort lst ref) ref)
51.         )
52.     )
53. )

I have also used Entity Handles over Entity Names as its easier to track.

[ElpanovEvgeniy]

Yes, it works perfectly! 

[Lee Mac]

Here are my suggestions for your function:

Code - Auto/Visual Lisp: [Select]

1. (defun eea-test-1-lm ( / f e i l s )
2.  
3.     (defun f ( l a / b c )
4.         (foreach x l
5.             (if (vl-every '<= (car a) (car x) (cadr a))
6.                 (setq b (cons x b))
7.                 (setq c (cons x c))
8.             )
9.         )
10.         (cons
11.             (if b
12.                 (cons (last a) (f (cdr (reverse b)) (last b)))
13.                 (cddr a)
14.             )
15.             (if c
16.                 (f (cdr (reverse c)) (last c))
17.             )
18.         )
19.     )
20.  
21.     (if (setq s (ssget '((0 . "LWPOLYLINE") (90 . 4) (-4 . "&=") (70 . 1))))
22.         (progn
23.             (repeat (setq i (sslength s))
24.                 (setq e (ssname s (setq i (1- i)))
25.                       l (cons (reverse (cons (cdr (assoc 5 (entget e))) (reverse (acet-geom-extents e)))) l)
26.                 )
27.             )
28.             (setq l (vl-sort l (function (lambda ( a b ) (< (caar a) (caar b))))))
29.             (f (cdr l) (car l))
30.         )
31.     )
32. )

I hope you don't mind 

[ElpanovEvgeniy]

the other - whiling away the way:

Code - Auto/Visual Lisp: [Select]

1. (defun eea-test-1 (/ f l)
2.   (defun f (l a b c)
3.     (cond ((not l)
4.            (cons (if b
5.                    (cons (last a) (f (cdr (reverse b)) (last b) nil nil))
6.                    (cddr a)
7.                  )
8.                  (if c
9.                    (f (cdr (reverse c)) (last c) nil nil)
10.                  )
11.            )
12.           )
13.           ((vl-every (function <=) (car a) (caar l) (cadr a)) (f (cdr l) a (cons (car l) b) c))
14.           ((f (cdr l) a b (cons (car l) c)))
15.     )
16.   )
17.   (if (setq l (ssget '((0 . "LWPOLYLINE") (90 . 4) (-4 . "&=") (70 . 1))))
18.     (progn (setq l (vl-sort (mapcar (function (lambda (a) (reverse (cons a (acet-geom-extents a))))) (acet-ss-to-list l))
19.                             (function (lambda (a b) (<= (caar a) (caar b))))
20.                    )
21.            )
22.            (f (cdr l) (car l) nil nil)
23.     )
24.   )
25. )

maybe it's slower but shorter...

[Lee Mac]

Evgeniy,

When using:

Code - Auto/Visual Lisp: [Select]

1. (reverse (cons a (acet-geom-extents a)))

This will never be true:

Code - Auto/Visual Lisp: [Select]

1. (vl-every (function <=) (car a) (caar l) (cadr a))

Since the coordinates of (car a) [upper-right corner] will always be greater than (cadr a) [lower-left corner]

[ElpanovEvgeniy]

Thank you!  Fixed... 

Code - Auto/Visual Lisp: [Select]

1. (defun eea-test-2 (/ f l)
2.   (defun f (l a b c)
3.     (cond ((not l)
4.            (cons (if b
5.                    (cons (last a) (f (cdr (reverse b)) (last b) nil nil))
6.                    (cddr a)
7.                  )
8.                  (if c
9.                    (f (cdr (reverse c)) (last c) nil nil)
10.                  )
11.            )
12.           )
13.           ((vl-every (function >=) (car a) (caar l) (cadr a)) (f (cdr l) a (cons (car l) b) c))
14.           ((f (cdr l) a b (cons (car l) c)))
15.     )
16.   )
17.   (if (setq l (ssget '((0 . "LWPOLYLINE") (90 . 4) (-4 . "&=") (70 . 1))))
18.     (progn (setq l (vl-sort (mapcar (function (lambda (a) (reverse (cons a (acet-geom-extents a))))) (acet-ss-to-list l))
19.                             (function (lambda (a b) (>= (caar a) (caar b))))
20.                    )
21.            )
22.            (f (cdr l) (car l) nil nil)
23.     )
24.   )
25. )

[ElpanovEvgeniy]

new version:

Code - Auto/Visual Lisp: [Select]

1. (defun eea-test-3 (/ f l)
2.   (defun f (l a b c)
3.     (cond ((not l)
4.            (cons (if b
5.                    (cons a (f (cdr (reverse b)) (last b) nil nil))
6.                    (list a)
7.                  )
8.                  (if c
9.                    (f (cdr (reverse c)) (last c) nil nil)
10.                  )
11.            )
12.           )
13.           ((equal (acet-geom-extents a) (ACET-GEOM-SS-EXTENTS-ACCURATE (ssadd (car l) (ssadd a (ssadd)))))
14.            (f (cdr l) a (cons (car l) b) c)
15.           )
16.           ((f (cdr l) a b (cons (car l) c)))
17.     )
18.   )
19.   (if (setq l (ssget '((0 . "LWPOLYLINE") (90 . 4) (-4 . "&=") (70 . 1))))
20.     (progn (setq l (vl-sort (acet-ss-to-list l)
21.                             (function (lambda (a b) (>= (vlax-curve-getarea a) (vlax-curve-getarea b))))
22.                    )
23.            )
24.            (f (cdr l) (car l) nil nil)
25.     )
26.   )
27. )

running slow...