Topic: ==={Challenge}=== Broken Pieces

[ribarm]

Also, if I may put remark... Evgeniy and Lee's intervention to the code didn't include the case in witch plines are drawn in reverse direction, so if all distances and edges are different this should work in any situation :

Code - Auto/Visual Lisp: [Select]

1. (defun c:jigsaw ( / LM:ListClockwise-p a a1 a2 b d e i l s v v1 x y )
2.  
3.     (vl-load-com)
4.  
5.     (defun LM:ListClockwise-p ( lst )
6.       (minusp
7.         (apply '+
8.           (mapcar
9.             (function
10.               (lambda ( a b )
11.                 (- (* (car b) (cadr a)) (* (car a) (cadr b)))
12.               )
13.             ) lst (cons (last lst) lst)
14.           )
15.         )
16.       )
17.     )
18.  
19.     (if (setq s (ssget "_:L" '((0 . "LWPOLYLINE") (-4 . "&=") (70 . 1))))
20.        (progn
21.            (repeat (setq i (sslength s))
22.                (setq e (ssname s (setq i (1- i)))
23.                      v (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) (entget e)))
24.                )
25.                (if (LM:ListClockwise-p v)
26.                    (progn
27.                       (command "_.reverse" e "")
28.                       (setq v (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) (entget e))))
29.                    )
30.                )
31.                (setq l (cons (cons (vlax-ename->vla-object e) (mapcar 'list v (cons (last v) v))) l))
32.            )
33.            (setq a (list (car l))
34.                  l (cdr l)
35.            )
36.            (while (and (setq b (car a)) l)
37.                (setq v (mapcar '- (cadadr b) (caadr b)))
38.                (foreach c l
39.                    (if (setq d (car (vl-member-if '(lambda ( x ) (equal v (mapcar '- (car x) (cadr x)) 1e-6)) (cdr c))))
40.                        (progn
41.                            (setq a2 (assoc (car c) l)
42.                                  v1 (mapcar '- (cadr d) (caadr b))
43.                                  a1 (cons (cons (car c) (mapcar '(lambda ( x ) (mapcar '(lambda ( y ) (mapcar '- y v1)) x)) (vl-remove d (cdr a2)))) a1)
44.                                   l (vl-remove a2 l)
45.                            )
46.                            (vla-move (car c) (vlax-3D-point (cadr d)) (vlax-3D-point (caadr b)))
47.                        )
48.                    )
49.                )
50.                (setq a (append (if (cddar a) (cons (cons (car a) (cddar a)) (cdr a)) (cdr a)) a1)
51.                      a1 nil
52.                )
53.            )
54.        )
55.    )
56.    (princ)
57. )
58.  

Regards, M.R.

[Lee Mac]

There is no need to reverse & modify the source objects; this should suffice:

Code - Auto/Visual Lisp: [Select]

1. (defun c:test ( / a a1 a2 b d e i l p s v w x y )
2.     (if (setq s (ssget "_:L" '((0 . "LWPOLYLINE") (-4 . "&=") (70 . 1))))
3.         (progn
4.             (repeat (setq i (sslength s))
5.                 (setq e (ssname s (setq i (1- i)))
6.                       v (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) (entget e)))
7.                       l (cons (cons (vlax-ename->vla-object e) (mapcar 'list v (cons (last v) v))) l)
8.                 )
9.             )
10.             (setq a (list (car l))
11.                   l (cdr l)
12.             )
13.             (while (and (setq b (car a)) l)
14.                 (setq v (mapcar '- (cadadr b) (caadr b)))
15.                 (foreach c l
16.                     (if (setq d
17.                             (vl-member-if
18.                                '(lambda ( x )
19.                                     (cond ((equal v (mapcar '- (car x) (cadr x)) 1e-6) (setq p (cadr x)))
20.                                           ((equal v (mapcar '- (cadr x) (car x)) 1e-6) (setq p (car  x)))
21.                                     )
22.                                 )
23.                                 (cdr c)
24.                             )
25.                         )
26.                         (progn
27.                             (setq a2 (assoc (car c) l)
28.                                    w (mapcar '- p (caadr b))
29.                                   a1 (cons (cons (car c) (mapcar '(lambda ( x ) (mapcar '(lambda ( y ) (mapcar '- y w)) x)) (vl-remove d (cdr a2)))) a1)
30.                                    l (vl-remove a2 l)
31.                             )
32.                             (vla-move (car c) (vlax-3D-point p) (vlax-3D-point (caadr b)))
33.                         )
34.                     )
35.                 )
36.                 (setq a (append (if (cddar a) (cons (cons (car a) (cddar a)) (cdr a)) (cdr a)) a1)
37.                       a1 nil
38.                 )
39.             )
40.         )
41.     )
42.     (princ)
43. )
44. (vl-load-com)

[fixo]

The above will put together the shapes.-

Thanks LE, it's working good through A2010-14
with small changes per release
Regards,

[ribarm]

There is no need to reverse & modify the source objects; this should suffice:

Code - Auto/Visual Lisp: [Select]

1. (defun c:test ( / a a1 a2 b d e i l p s v w x y )

Look Lee, I see that you really want to solve this code to be as short as possible, but test it on attached example... Your previous code was correct, only necessity was reversing of plines... In case CAD doesn't support (command "_.reverse"), Evgeniy solved this for LWPOLYLINE in sub-function (rlw)... Your new code fails here, and in case of preserving reversion, we can always build list of entities that were reversed and in the end reverse them back as they were before execution of routine...

Code - Auto/Visual Lisp: [Select]

1. (defun c:jigsaw ( / LM:ListClockwise-p rlw el a a1 a2 b d e i l s v v1 x y )
2.  
3.     (vl-load-com)
4.  
5.     (defun LM:ListClockwise-p ( lst )
6.       (minusp
7.         (apply '+
8.           (mapcar
9.             (function
10.               (lambda ( a b )
11.                 (- (* (car b) (cadr a)) (* (car a) (cadr b)))
12.               )
13.             ) lst (cons (last lst) lst)
14.           )
15.         )
16.       )
17.     )
18.  
19.     (defun rlw ( LW / E X1 X2 X3 X4 X5 X6 )
20.         ;; by ElpanovEvgeniy
21.         ;; reverse lwpolyline
22.         (if (= (cdr (assoc 0 (setq e (entget lw)))) "LWPOLYLINE")
23.             (progn
24.                 (foreach a1 e
25.                     (cond ((= (car a1) 10) (setq x2 (cons a1 x2)))
26.                           ((= (car a1) 40) (setq x4 (cons (cons 41 (cdr a1)) x4)))
27.                           ((= (car a1) 41) (setq x3 (cons (cons 40 (cdr a1)) x3)))
28.                           ((= (car a1) 42) (setq x5 (cons (cons 42 (- (cdr a1))) x5)))
29.                           ((= (car a1) 210) (setq x6 (cons a1 x6)))
30.                           (t (setq x1 (cons a1 x1)))
31.                     )
32.                 )
33.                 (entmod
34.                     (append
35.                         (reverse x1)
36.                             (append
37.                                 (apply
38.                                     (function append)
39.                                         (apply
40.                                             (function mapcar)
41.                                                 (cons 'list
42.                                                     (list x2
43.                                                         (cdr (reverse (cons (car x3) (reverse x3))))
44.                                                         (cdr (reverse (cons (car x4) (reverse x4))))
45.                                                         (cdr (reverse (cons (car x5) (reverse x5))))
46.                                                     )
47.                                                 )
48.                                         )
49.                                 )
50.                                 x6
51.                             )
52.                     )
53.                 )
54.                 (entupd lw)
55.             )
56.         )
57.     )
58.  
59.     (if (setq s (ssget "_:L" '((0 . "LWPOLYLINE") (-4 . "&=") (70 . 1))))
60.         (progn
61.             (repeat (setq i (sslength s))
62.                 (setq e (ssname s (setq i (1- i)))
63.                       v (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) (entget e)))
64.                 )
65.                 (if (LM:ListClockwise-p v)
66.                     (progn
67.                        (rlw e)
68.                        (setq el (cons e el))
69.                        (setq v (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) (entget e))))
70.                     )
71.                 )
72.                 (setq l (cons (cons (vlax-ename->vla-object e) (mapcar 'list v (cons (last v) v))) l))
73.             )
74.             (setq a (list (car l))
75.                   l (cdr l)
76.             )
77.             (while (and (setq b (car a)) l)
78.                 (setq v (mapcar '- (cadadr b) (caadr b)))
79.                 (foreach c l
80.                     (if (setq d (car (vl-member-if '(lambda ( x ) (equal v (mapcar '- (car x) (cadr x)) 1e-6)) (cdr c))))
81.                         (progn
82.                             (setq a2 (assoc (car c) l)
83.                                   v1 (mapcar '- (cadr d) (caadr b))
84.                                   a1 (cons (cons (car c) (mapcar '(lambda ( x ) (mapcar '(lambda ( y ) (mapcar '- y v1)) x)) (vl-remove d (cdr a2)))) a1)
85.                                    l (vl-remove a2 l)
86.                             )
87.                             (vla-move (car c) (vlax-3D-point (cadr d)) (vlax-3D-point (caadr b)))
88.                         )
89.                     )
90.                 )
91.                 (setq a (append (if (cddar a) (cons (cons (car a) (cddar a)) (cdr a)) (cdr a)) a1)
92.                       a1 nil
93.                 )
94.             )
95.         )
96.     )
97.    
98.     (foreach e el
99.         (rlw e)
100.     )
101.    
102.     (princ)
103. )
104.  

M.R.

[Lee Mac]

The issue is due to multiple pieces having edges of the same length - this is an obvious restriction of the algorithm implemented in both Evgeniy's & my code and was stated earlier in the thread.

Even if all LWPolylines have the same direction, the method used by the program still has the potential to return incorrect results if more than two edges have the same 'edge' vector, hence your proposed modifcations will also fail for these cases.

[ribarm]

The issue is due to multiple pieces having edges of the same length - this is an obvious restriction of the algorithm implemented in both Evgeniy's & my code and was stated earlier in the thread.

Even if all LWPolylines have the same direction, the method used by the program still has the potential to return incorrect results if more than two edges have the same 'edge' vector, hence your proposed modifcations will also fail for these cases.

I know limitations ab distances and equal vectors, but why then on my attached dwg, my version works fine, and your fails?

[ribarm]

The issue is due to multiple pieces having edges of the same length - this is an obvious restriction of the algorithm implemented in both Evgeniy's & my code and was stated earlier in the thread.

Even if all LWPolylines have the same direction, the method used by the program still has the potential to return incorrect results if more than two edges have the same 'edge' vector, hence your proposed modifcations will also fail for these cases.

I know limitations ab distances and equal vectors, but why then on my attached dwg, my version works fine, and your fails?

Yes, Lee, I suppose you're right... My example has 2 edges that are the same distance and angle as 2 edges of next two pieces and 2 edges of pieces that should compose rectangle with different pieces... So this is really bad example... Never mind, I suppose both versions should work in other situation where all edges are different...

[LE3]

Thanks LE, it's working good through A2010-14
with small changes per release
Regards,

I am glad you tried - Thanks Oleg !

[ribarm]

I want to revive this topic as I've coded something likewise jigsaw... Still, not 100% sure it would be bullet proof, but here is it...

Code - Auto/Visual Lisp: [Select]

1. (defun c:jigsaw-ortho ( / *error* listclockwise-p rlw jigsaw s ss i lws orth chk )
2.  
3.   (vl-load-com)
4.  
5.   (defun *error* ( m )
6.     (if (= 8 (logand 8 (getvar (quote undoctl))))
7.       (if command-s
8.         (command-s "_.UNDO" "_E")
9.         (vl-cmdf "_.UNDO" "_E")
10.       )
11.     )
12.     (if m
13.       (prompt m)
14.     )
15.     (princ)
16.   )
17.  
18.   (defun listclockwise-p ( lst )
19.     ;; by Lee Mac
20.     (minusp
21.       (apply (function +)
22.         (mapcar
23.           (function (lambda ( a b )
24.             (- (* (car b) (cadr a)) (* (car a) (cadr b)))
25.           ))
26.           lst
27.           (cons (last lst) lst)
28.         )
29.       )
30.     )
31.   )
32.  
33.   (defun rlw ( lw / e x1 x2 x3 x4 x5 x6 )
34.     ;; by Elpanov Evgeniy
35.     (if (= (cdr (assoc 0 (setq e (entget lw)))) "LWPOLYLINE")
36.       (progn
37.         (foreach a1 e
38.           (cond
39.             ( (= (car a1) 10) (setq x2 (cons a1 x2)) )
40.             ( (= (car a1) 40) (setq x4 (cons (cons 41 (cdr a1)) x4)) )
41.             ( (= (car a1) 41) (setq x3 (cons (cons 40 (cdr a1)) x3)) )
42.             ( (= (car a1) 42) (setq x5 (cons (cons 42 (- (cdr a1))) x5)) )
43.             ( (= (car a1) 210) (setq x6 (cons a1 x6)) )
44.             ( t (setq x1 (cons a1 x1)) )
45.           )
46.         )
47.         (entmod
48.           (append
49.             (reverse x1)
50.             (append
51.               (apply (function append)
52.                 (apply (function mapcar)
53.                   (cons (function list)
54.                     (list
55.                       x2
56.                       (cdr (reverse (cons (car x3) (reverse x3))))
57.                       (cdr (reverse (cons (car x4) (reverse x4))))
58.                       (cdr (reverse (cons (car x5) (reverse x5))))
59.                     )
60.                   )
61.                 )
62.               )
63.               x6
64.             )
65.           )
66.         )
67.         (entupd lw)
68.       )
69.     )
70.   )
71.  
72.   (defun jigsaw ( lws orth chk / unique inspectlw process lw lww lwww lwso lwss lwd lwdd lwwd q f )
73.  
74.     (defun unique ( lwd )
75.       (if lwd
76.         (cons
77.           (car lwd)
78.           (unique
79.             (vl-remove-if
80.               (function (lambda ( x )
81.                 (and
82.                   (equal (distance (caar lwd) (caddar lwd)) (distance (car x) (caddr x)) 1e-6)
83.                   (or
84.                     (equal (cadar lwd) (cadr x) 1e-6)
85.                     (equal (rem (+ (cadar lwd) pi pi) (+ pi pi)) (rem (+ (cadr x) pi) (+ pi pi)) 1e-6)
86.                     (equal (rem (+ (cadar lwd) pi) (+ pi pi)) (rem (+ (cadr x) pi pi) (+ pi pi)) 1e-6)
87.                   )
88.                 )
89.               ))
90.               (cdr lwd)
91.             )
92.           )
93.         )
94.       )
95.     )
96.  
97.     (defun inspectlw ( lw / lwx pts p0 angs edgs )
98.       (setq lwx (entget lw))
99.       (setq pts (mapcar (function cdr) (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) lwx)))
100.       (setq p0 (car pts))
101.       (foreach p1 (cdr pts)
102.         (if
103.           (or
104.             (< (cadr p1) (cadr p0))
105.             (and (= (cadr p1) (cadr p0)) (< (car p1) (car p0)))
106.           )
107.           (setq p0 p1)
108.         )
109.       )
110.       (setq pts (append (member p0 pts) (reverse (cdr (member p0 (reverse pts))))))
111.       (setq angs (mapcar (function (lambda ( a b ) (angle a b))) pts (append (cdr pts) (list (car pts)))))
112.       (setq edgs (mapcar (function (lambda ( p1 a p2 ) (list p1 a p2))) pts angs (append (cdr pts) (list (car pts)))))
113.     )
114.  
115.     (defun process ( lws n lwd orth chk )
116.       (if (and (setq lw (car lws)) (not lwd))
117.         (setq lws (cdr lws) lwd (inspectlw lw))
118.       )
119.       (while (> n 1)
120.         (foreach lww lws
121.           (if lww
122.             (setq lwwd (inspectlw lww))
123.           )
124.           (vl-some
125.             (function (lambda ( edg1 )
126.               (vl-some
127.                 (function (lambda ( edg2 )
128.                   (if
129.                     (and
130.                       (equal (distance (car edg1) (caddr edg1)) (distance (car edg2) (caddr edg2)) 1e-6)
131.                       (if (not orth)
132.                         (if
133.                           (and
134.                             (not (equal (cadr edg1) 0.0 1e-6))
135.                             (not (equal (cadr edg2) 0.0 1e-6))
136.                             (not (equal (cadr edg1) (* 0.5 pi) 1e-6))
137.                             (not (equal (cadr edg2) (* 0.5 pi) 1e-6))
138.                             (not (equal (cadr edg1) pi 1e-6))
139.                             (not (equal (cadr edg2) pi 1e-6))
140.                             (not (equal (cadr edg1) (* 1.5 pi) 1e-6))
141.                             (not (equal (cadr edg2) (* 1.5 pi) 1e-6))
142.                             (not (equal (cadr edg1) (* 2.0 pi) 1e-6))
143.                             (not (equal (cadr edg2) (* 2.0 pi) 1e-6))
144.                           )
145.                           t
146.                         )
147.                         (if chk
148.                           (vl-some
149.                             (function (lambda ( edg3 )
150.                               (vl-some
151.                                 (function (lambda ( edg4 )
152.                                   (and
153.                                     (equal (distance (car edg3) (caddr edg3)) (distance (car edg4) (caddr edg4)) 1e-6)
154.                                     (or
155.                                       (equal (cadr edg3) (cadr edg4) 1e-6)
156.                                       (equal (rem (+ (cadr edg3) pi) (+ pi pi)) (rem (+ (cadr edg4) pi pi) (+ pi pi)) 1e-6)
157.                                       (equal (rem (+ (cadr edg3) pi pi) (+ pi pi)) (rem (+ (cadr edg4) pi) (+ pi pi)) 1e-6)
158.                                     )
159.                                   )
160.                                 ))
161.                                 (vl-remove edg2 lwwd)
162.                               )
163.                             ))
164.                             (vl-remove edg1 lwd)
165.                           )
166.                           t
167.                         )
168.                       )
169.                       (or
170.                         (equal (cadr edg1) (cadr edg2) 1e-6)
171.                         (equal (rem (+ (cadr edg1) pi) (+ pi pi)) (rem (+ (cadr edg2) pi pi) (+ pi pi)) 1e-6)
172.                         (equal (rem (+ (cadr edg1) pi pi) (+ pi pi)) (rem (+ (cadr edg2) pi) (+ pi pi)) 1e-6)
173.                       )
174.                     )
175.                     (progn
176.                       (setq lws (vl-remove lww lws) n (1- n))
177.                       (if (and edg3 edg4)
178.                         (cond
179.                           ( (and (equal (cadr edg3) (cadr edg4) 1e-6) (equal (car edg1) (car edg3) 1e-6) (equal (car edg2) (car edg4) 1e-6))
180.                             (vla-move (vlax-ename->vla-object lww) (vlax-3d-point (car edg4)) (vlax-3d-point (car edg3)))
181.                             (foreach x lwwd
182.                               (if (not (equal edg4 x 1e-6))
183.                                 (progn
184.                                   (setq xx (subst (mapcar (function +) (mapcar (function -) (car edg3) (car edg4)) (car x)) (car x) x))
185.                                   (setq xx (subst (mapcar (function +) (mapcar (function -) (car edg3) (car edg4)) (caddr xx)) (caddr xx) xx))
186.                                   (setq lwd (cons xx lwd))
187.                                 )
188.                               )
189.                             )
190.                             (setq lwd (vl-remove edg3 lwd))
191.                             (setq lwd (unique lwd))
192.                           )
193.                           ( (and
194.                               (or
195.                                 (equal (rem (+ (cadr edg3) pi) (+ pi pi)) (rem (+ (cadr edg4) pi pi) (+ pi pi)) 1e-6)
196.                                 (equal (rem (+ (cadr edg3) pi pi) (+ pi pi)) (rem (+ (cadr edg4) pi) (+ pi pi)) 1e-6)
197.                               )
198.                               (equal (car edg1) (car edg3) 1e-6)
199.                               (equal (car edg2) (car edg4) 1e-6)
200.                             )
201.                             (vla-move (vlax-ename->vla-object lww) (vlax-3d-point (caddr edg4)) (vlax-3d-point (car edg3)))
202.                             (foreach x lwwd
203.                               (if (not (equal edg4 x 1e-6))
204.                                 (progn
205.                                   (setq xx (subst (mapcar (function +) (mapcar (function -) (car edg3) (caddr edg4)) (car x)) (car x) x))
206.                                   (setq xx (subst (mapcar (function +) (mapcar (function -) (car edg3) (caddr edg4)) (caddr xx)) (caddr xx) xx))
207.                                   (setq lwd (cons xx lwd))
208.                                 )
209.                               )
210.                             )
211.                             (setq lwd (vl-remove edg3 lwd))
212.                             (setq lwd (unique lwd))
213.                           )
214.                         )
215.                         (cond
216.                           ( (equal (cadr edg1) (cadr edg2) 1e-6)
217.                             (vla-move (vlax-ename->vla-object lww) (vlax-3d-point (car edg2)) (vlax-3d-point (car edg1)))
218.                             (foreach x lwwd
219.                               (if (not (equal edg2 x 1e-6))
220.                                 (progn
221.                                   (setq xx (subst (mapcar (function +) (mapcar (function -) (car edg1) (car edg2)) (car x)) (car x) x))
222.                                   (setq xx (subst (mapcar (function +) (mapcar (function -) (car edg1) (car edg2)) (caddr xx)) (caddr xx) xx))
223.                                   (setq lwd (cons xx lwd))
224.                                 )
225.                               )
226.                             )
227.                             (setq lwd (vl-remove edg1 lwd))
228.                             (setq lwd (unique lwd))
229.                           )
230.                           ( (or
231.                               (equal (rem (+ (cadr edg1) pi) (+ pi pi)) (rem (+ (cadr edg2) pi pi) (+ pi pi)) 1e-6)
232.                               (equal (rem (+ (cadr edg1) pi pi) (+ pi pi)) (rem (+ (cadr edg2) pi) (+ pi pi)) 1e-6)
233.                             )
234.                             (vla-move (vlax-ename->vla-object lww) (vlax-3d-point (caddr edg2)) (vlax-3d-point (car edg1)))
235.                             (foreach x lwwd
236.                               (if (not (equal edg2 x 1e-6))
237.                                 (progn
238.                                   (setq xx (subst (mapcar (function +) (mapcar (function -) (car edg1) (caddr edg2)) (car x)) (car x) x))
239.                                   (setq xx (subst (mapcar (function +) (mapcar (function -) (car edg1) (caddr edg2)) (caddr xx)) (caddr xx) xx))
240.                                   (setq lwd (cons xx lwd))
241.                                 )
242.                               )
243.                             )
244.                             (setq lwd (vl-remove edg1 lwd))
245.                             (setq lwd (unique lwd))
246.                           )
247.                         )
248.                       )
249.                     )
250.                   )
251.                 ))
252.                 lwwd
253.               )
254.             ))
255.             lwd
256.           )
257.         )
258.       )
259.       lwd
260.     )
261.  
262.     (foreach lw lws
263.       (if lw
264.         (setq lwdd (inspectlw lw))
265.       )
266.       (cond
267.         ( (and
268.             orth
269.             (vl-every
270.               (function (lambda ( w )
271.                 (or
272.                   (equal (cadr w) 0.0 1e-6)
273.                   (equal (cadr w) (* 0.5 pi) 1e-6)
274.                   (equal (cadr w) pi 1e-6)
275.                   (equal (cadr w) (* 1.5 pi) 1e-6)
276.                   (equal (cadr w) (* 2 pi) 1e-6)
277.                 )
278.               ))
279.               lwdd
280.             )
281.           )
282.           (setq lws (vl-remove lw lws) lwso (cons lw lwso))
283.         )
284.         ( (and
285.             (not orth)
286.             (vl-every
287.               (function (lambda ( w )
288.                 (or
289.                   (equal (cadr w) 0.0 1e-6)
290.                   (equal (cadr w) (* 0.5 pi) 1e-6)
291.                   (equal (cadr w) pi 1e-6)
292.                   (equal (cadr w) (* 1.5 pi) 1e-6)
293.                   (equal (cadr w) (* 2 pi) 1e-6)
294.                 )
295.               ))
296.               lwdd
297.             )
298.           )
299.           (setq lws (vl-remove lw lws))
300.         )
301.       )
302.     )
303.     (setq lwd (process lws (length lws) nil orth (not chk)))
304.     (if orth
305.       (progn
306.         (setq lwd (process (list (setq q (car (vl-sort lwso (function (lambda ( a b ) (< (vlax-curve-getarea a) (vlax-curve-getarea b)))))))) 2 lwd orth (not chk)))
307.         (setq lwso (vl-remove q lwso))
308.         (while
309.           (or
310.             (setq lwww (vl-some (function (lambda ( z / xx ) (if (and (setq xx (vl-some (function (lambda ( a ) (vl-some (function (lambda ( x ) (if (equal (distance (car a) (caddr a)) (distance (car x) (caddr x)) 1e-6) (list x a)))) (apply (function append) (mapcar (function inspectlw) lws))))) (apply (function append) (mapcar (function inspectlw) lwso)))) (vl-some (function (lambda ( b ) (vl-some (function (lambda ( y ) (and (not (equal b (car xx) 1e-6)) (not (equal b (cadr xx) 1e-6)) (not (equal y (car xx) 1e-6)) (not (equal y (cadr xx) 1e-6)) (equal (distance (car b) (caddr b)) (distance (car y) (caddr y)) 1e-6)))) (apply (function append) (mapcar (function inspectlw) lws))))) (apply (function append) (mapcar (function inspectlw) lwso)))) z))) (mapcar (function inspectlw) lwso)))
311.             (car lwso)
312.           )
313.           (if (cdr lwso)
314.             (foreach w lwso
315.               (if (equal (inspectlw w) lwww 1e-6)
316.                 (progn
317.                   (if (listclockwise-p (mapcar (function cdr) (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) (entget w))))
318.                     (setq lwd (process (list w) 2 (if (not f) (progn (setq f t) (reverse lwd)) lwd) orth (not chk)))
319.                     (setq lwd (process (list w) 2 lwd orth (not chk)))
320.                   )
321.                   (setq lwso (vl-remove w lwso))
322.                 )
323.               )
324.             )
325.             (progn
326.               (process (list (car lwso)) 2 lwd orth chk)
327.               (setq lwso nil)
328.             )
329.           )
330.         )
331.       )
332.     )
333.   )
334.  
335.   (if (= 8 (logand 8 (getvar (quote undoctl))))
336.     (if command-s
337.       (command-s "_.UNDO" "_E")
338.       (vl-cmdf "_.UNDO" "_E")
339.     )
340.   )
341.   (if command-s
342.     (command-s "_.UNDO" "_M")
343.     (vl-cmdf "_.UNDO" "_M")
344.   )
345.   (initget "Yes No")
346.   (setq orth (cond ( (getkword "\nEnable ortho or not [Yes / No] <Yes> : ") ) ( "Yes" ) ))
347.   (if (= orth "Yes")
348.     (setq orth t)
349.     (setq orth nil)
350.   )
351.   (initget "Yes No")
352.   (setq chk (cond ( (getkword "\nChoose check for ortho - if it stals chose \"No\" next time [Yes / No] <Yes> : ") ) ( "Yes" ) ))
353.   (if (= chk "Yes")
354.     (setq chk t)
355.     (setq chk nil)
356.   )
357.   (prompt "\nSelect polygons you want CW - non orthogonal <ENTER - CONTINUE> : ")
358.   (if (setq s (ssget "_:L" (list (cons 0 "LWPOLYLINE") (cons -4 "&") (cons 70 1) (cons -4 "<NOT") (cons -4 "<>") (cons 42 0.0) (cons -4 "NOT>"))))
359.     (foreach lw (vl-remove-if (function listp) (mapcar (function cadr) (ssnamex s)))
360.       (if (not (listclockwise-p (mapcar (function cdr) (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) (entget lw)))))
361.         (rlw lw)
362.       )
363.     )
364.   )
365.   (prompt "\nSelect polygons you want CCW - orthogonal <ENTER - CONTINUE> : ")
366.   (if (setq s (ssget "_:L" (list (cons 0 "LWPOLYLINE") (cons -4 "&") (cons 70 1) (cons -4 "<NOT") (cons -4 "<>") (cons 42 0.0) (cons -4 "NOT>"))))
367.     (foreach lw (vl-remove-if (function listp) (mapcar (function cadr) (ssnamex s)))
368.       (if (listclockwise-p (mapcar (function cdr) (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) (entget lw))))
369.         (rlw lw)
370.       )
371.     )
372.   )
373.   (prompt "\nSelect polygonal LWPOLYLINE(s) on unlocked Layer(s)...")
374.   (if (setq ss (ssget "_:L" (list (cons 0 "LWPOLYLINE") (cons -4 "&") (cons 70 1) (cons -4 "<NOT") (cons -4 "<>") (cons 42 0.0) (cons -4 "NOT>"))))
375.     (progn
376.       (repeat (setq i (sslength ss))
377.         (setq lws (cons (ssname ss (setq i (1- i))) lws))
378.       )
379.       (jigsaw lws orth chk)
380.     )
381.   )
382.   (*error* nil)
383. )
384.  

I am waiting to see if we'll get some comment...
Regards, M.R.

[ribarm]

Can someone solve jigsaw for orthogonal pieces... I am attaching *.DWG for testing purposes... For now I've updated my last input, but nevertheless it is not working with orthogonal pieces - rectangles... I am waiting to see if someone will jump in...

Thanks, M.R.

[ribarm]

I've updated code from here : https://www.theswamp.org/index.php?topic=44783.msg613184#msg613184
But I still think that it's very hard to solve it correctly - added option for turning some polygons clockWise / Counterclockwise...

If you have a spare time, it's just for fun to check, as I think it can't be programmed well upon choosing various options...

[ribarm]

I've coded for that one example, but just for this case... Now how can we manage to find general solution, and this is 3 steps selection + twice ENTER...

Code - Auto/Visual Lisp: [Select]

1. (defun c:jigsaw-ortho ( / *error* listclockwise-p rlw jigsaw s ss i lws orth chk )
2.  
3.   (vl-load-com)
4.  
5.   (defun *error* ( m )
6.     (if (= 8 (logand 8 (getvar (quote undoctl))))
7.       (if command-s
8.         (command-s "_.UNDO" "_E")
9.         (vl-cmdf "_.UNDO" "_E")
10.       )
11.     )
12.     (if m
13.       (prompt m)
14.     )
15.     (princ)
16.   )
17.  
18.   (defun listclockwise-p ( lst )
19.     ;; by Lee Mac
20.     (minusp
21.       (apply (function +)
22.         (mapcar
23.           (function (lambda ( a b )
24.             (- (* (car b) (cadr a)) (* (car a) (cadr b)))
25.           ))
26.           lst
27.           (cons (last lst) lst)
28.         )
29.       )
30.     )
31.   )
32.  
33.   (defun rlw ( lw / e x1 x2 x3 x4 x5 x6 )
34.     ;; by Elpanov Evgeniy
35.     (if (= (cdr (assoc 0 (setq e (entget lw)))) "LWPOLYLINE")
36.       (progn
37.         (foreach a1 e
38.           (cond
39.             ( (= (car a1) 10) (setq x2 (cons a1 x2)) )
40.             ( (= (car a1) 40) (setq x4 (cons (cons 41 (cdr a1)) x4)) )
41.             ( (= (car a1) 41) (setq x3 (cons (cons 40 (cdr a1)) x3)) )
42.             ( (= (car a1) 42) (setq x5 (cons (cons 42 (- (cdr a1))) x5)) )
43.             ( (= (car a1) 210) (setq x6 (cons a1 x6)) )
44.             ( t (setq x1 (cons a1 x1)) )
45.           )
46.         )
47.         (entmod
48.           (append
49.             (reverse x1)
50.             (append
51.               (apply (function append)
52.                 (apply (function mapcar)
53.                   (cons (function list)
54.                     (list
55.                       x2
56.                       (cdr (reverse (cons (car x3) (reverse x3))))
57.                       (cdr (reverse (cons (car x4) (reverse x4))))
58.                       (cdr (reverse (cons (car x5) (reverse x5))))
59.                     )
60.                   )
61.                 )
62.               )
63.               x6
64.             )
65.           )
66.         )
67.         (entupd lw)
68.       )
69.     )
70.   )
71.  
72.   (defun jigsaw ( lws orth chk / unique inspectlw process lw lww lwww lwso lwss lwd lwdd lwwd lwds q )
73.  
74.     (defun unique ( lwd )
75.       (if lwd
76.         (cons
77.           (car lwd)
78.           (unique
79.             (vl-remove-if
80.               (function (lambda ( x )
81.                 (and
82.                   (equal (distance (caar lwd) (caddar lwd)) (distance (car x) (caddr x)) 1e-6)
83.                   (or
84.                     (equal (cadar lwd) (cadr x) 1e-6)
85.                     (equal (rem (+ (cadar lwd) pi pi) (+ pi pi)) (rem (+ (cadr x) pi) (+ pi pi)) 1e-6)
86.                     (equal (rem (+ (cadar lwd) pi) (+ pi pi)) (rem (+ (cadr x) pi pi) (+ pi pi)) 1e-6)
87.                   )
88.                 )
89.               ))
90.               (cdr lwd)
91.             )
92.           )
93.         )
94.       )
95.     )
96.  
97.     (defun inspectlw ( lw / lwx pts p0 angs edgs )
98.       (setq lwx (entget lw))
99.       (setq pts (mapcar (function cdr) (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) lwx)))
100.       (setq p0 (car pts))
101.       (foreach p1 (cdr pts)
102.         (if
103.           (or
104.             (< (cadr p1) (cadr p0))
105.             (and (= (cadr p1) (cadr p0)) (< (car p1) (car p0)))
106.           )
107.           (setq p0 p1)
108.         )
109.       )
110.       (setq pts (append (member p0 pts) (reverse (cdr (member p0 (reverse pts))))))
111.       (setq angs (mapcar (function (lambda ( a b ) (angle a b))) pts (append (cdr pts) (list (car pts)))))
112.       (setq edgs (mapcar (function (lambda ( p1 a p2 ) (list p1 a p2))) pts angs (append (cdr pts) (list (car pts)))))
113.     )
114.  
115.     (defun process ( lws n lwd orth chk )
116.       (if (and (setq lw (car lws)) (not lwd))
117.         (setq lws (cdr lws) lwd (inspectlw lw))
118.       )
119.       (while (> n 1)
120.         (foreach lww lws
121.           (if lww
122.             (setq lwwd (inspectlw lww))
123.           )
124.           (vl-some
125.             (function (lambda ( edg1 )
126.               (vl-some
127.                 (function (lambda ( edg2 )
128.                   (if
129.                     (and
130.                       (equal (distance (car edg1) (caddr edg1)) (distance (car edg2) (caddr edg2)) 1e-6)
131.                       (if (not orth)
132.                         (if
133.                           (and
134.                             (not (equal (cadr edg1) 0.0 1e-6))
135.                             (not (equal (cadr edg2) 0.0 1e-6))
136.                             (not (equal (cadr edg1) (* 0.5 pi) 1e-6))
137.                             (not (equal (cadr edg2) (* 0.5 pi) 1e-6))
138.                             (not (equal (cadr edg1) pi 1e-6))
139.                             (not (equal (cadr edg2) pi 1e-6))
140.                             (not (equal (cadr edg1) (* 1.5 pi) 1e-6))
141.                             (not (equal (cadr edg2) (* 1.5 pi) 1e-6))
142.                             (not (equal (cadr edg1) (* 2.0 pi) 1e-6))
143.                             (not (equal (cadr edg2) (* 2.0 pi) 1e-6))
144.                           )
145.                           t
146.                         )
147.                         (if chk
148.                           (vl-some
149.                             (function (lambda ( edg3 )
150.                               (vl-some
151.                                 (function (lambda ( edg4 )
152.                                   (and
153.                                     (equal (distance (car edg3) (caddr edg3)) (distance (car edg4) (caddr edg4)) 1e-6)
154.                                     (or
155.                                       (equal (cadr edg3) (cadr edg4) 1e-6)
156.                                       (equal (rem (+ (cadr edg3) pi) (+ pi pi)) (rem (+ (cadr edg4) pi pi) (+ pi pi)) 1e-6)
157.                                       (equal (rem (+ (cadr edg3) pi pi) (+ pi pi)) (rem (+ (cadr edg4) pi) (+ pi pi)) 1e-6)
158.                                     )
159.                                   )
160.                                 ))
161.                                 (vl-remove edg2 lwwd)
162.                               )
163.                             ))
164.                             (vl-remove edg1 lwd)
165.                           )
166.                           t
167.                         )
168.                       )
169.                       (or
170.                         (equal (cadr edg1) (cadr edg2) 1e-6)
171.                         (equal (rem (+ (cadr edg1) pi) (+ pi pi)) (rem (+ (cadr edg2) pi pi) (+ pi pi)) 1e-6)
172.                         (equal (rem (+ (cadr edg1) pi pi) (+ pi pi)) (rem (+ (cadr edg2) pi) (+ pi pi)) 1e-6)
173.                       )
174.                     )
175.                     (progn
176.                       (setq lws (vl-remove lww lws) n (1- n))
177.                       (if (and edg3 edg4)
178.                         (cond
179.                           ( (and (equal (cadr edg3) (cadr edg4) 1e-6) (equal (car edg1) (car edg3) 1e-6) (equal (car edg2) (car edg4) 1e-6))
180.                             (vla-move (vlax-ename->vla-object lww) (vlax-3d-point (car edg4)) (vlax-3d-point (car edg3)))
181.                             (foreach x lwwd
182.                               (if (not (equal edg4 x 1e-6))
183.                                 (progn
184.                                   (setq xx (subst (mapcar (function +) (mapcar (function -) (car edg3) (car edg4)) (car x)) (car x) x))
185.                                   (setq xx (subst (mapcar (function +) (mapcar (function -) (car edg3) (car edg4)) (caddr xx)) (caddr xx) xx))
186.                                   (setq lwd (cons xx lwd))
187.                                 )
188.                               )
189.                             )
190.                             (setq lwd (vl-remove edg3 lwd))
191.                             ;(setq lwd (unique lwd))
192.                           )
193.                           ( (and
194.                               (or
195.                                 (equal (rem (+ (cadr edg3) pi) (+ pi pi)) (rem (+ (cadr edg4) pi pi) (+ pi pi)) 1e-6)
196.                                 (equal (rem (+ (cadr edg3) pi pi) (+ pi pi)) (rem (+ (cadr edg4) pi) (+ pi pi)) 1e-6)
197.                               )
198.                               (equal (car edg1) (car edg3) 1e-6)
199.                               (equal (car edg2) (car edg4) 1e-6)
200.                             )
201.                             (vla-move (vlax-ename->vla-object lww) (vlax-3d-point (caddr edg4)) (vlax-3d-point (car edg3)))
202.                             (foreach x lwwd
203.                               (if (not (equal edg4 x 1e-6))
204.                                 (progn
205.                                   (setq xx (subst (mapcar (function +) (mapcar (function -) (car edg3) (caddr edg4)) (car x)) (car x) x))
206.                                   (setq xx (subst (mapcar (function +) (mapcar (function -) (car edg3) (caddr edg4)) (caddr xx)) (caddr xx) xx))
207.                                   (setq lwd (cons xx lwd))
208.                                 )
209.                               )
210.                             )
211.                             (setq lwd (vl-remove edg3 lwd))
212.                             ;(setq lwd (unique lwd))
213.                           )
214.                         )
215.                         (cond
216.                           ( (equal (cadr edg1) (cadr edg2) 1e-6)
217.                             (vla-move (vlax-ename->vla-object lww) (vlax-3d-point (car edg2)) (vlax-3d-point (car edg1)))
218.                             (foreach x lwwd
219.                               (if (not (equal edg2 x 1e-6))
220.                                 (progn
221.                                   (setq xx (subst (mapcar (function +) (mapcar (function -) (car edg1) (car edg2)) (car x)) (car x) x))
222.                                   (setq xx (subst (mapcar (function +) (mapcar (function -) (car edg1) (car edg2)) (caddr xx)) (caddr xx) xx))
223.                                   (setq lwd (cons xx lwd))
224.                                 )
225.                               )
226.                             )
227.                             (setq lwd (vl-remove edg1 lwd))
228.                             ;(setq lwd (unique lwd))
229.                           )
230.                           ( (or
231.                               (equal (rem (+ (cadr edg1) pi) (+ pi pi)) (rem (+ (cadr edg2) pi pi) (+ pi pi)) 1e-6)
232.                               (equal (rem (+ (cadr edg1) pi pi) (+ pi pi)) (rem (+ (cadr edg2) pi) (+ pi pi)) 1e-6)
233.                             )
234.                             (vla-move (vlax-ename->vla-object lww) (vlax-3d-point (caddr edg2)) (vlax-3d-point (car edg1)))
235.                             (foreach x lwwd
236.                               (if (not (equal edg2 x 1e-6))
237.                                 (progn
238.                                   (setq xx (subst (mapcar (function +) (mapcar (function -) (car edg1) (caddr edg2)) (car x)) (car x) x))
239.                                   (setq xx (subst (mapcar (function +) (mapcar (function -) (car edg1) (caddr edg2)) (caddr xx)) (caddr xx) xx))
240.                                   (setq lwd (cons xx lwd))
241.                                 )
242.                               )
243.                             )
244.                             (setq lwd (vl-remove edg1 lwd))
245.                             ;(setq lwd (unique lwd))
246.                           )
247.                         )
248.                       )
249.                     )
250.                   )
251.                 ))
252.                 lwwd
253.               )
254.             ))
255.             lwd
256.           )
257.         )
258.       )
259.       lwd
260.     )
261.  
262.     (foreach lw lws
263.       (if lw
264.         (setq lwdd (inspectlw lw))
265.       )
266.       (cond
267.         ( (and
268.             orth
269.             (vl-every
270.               (function (lambda ( w )
271.                 (or
272.                   (equal (cadr w) 0.0 1e-6)
273.                   (equal (cadr w) (* 0.5 pi) 1e-6)
274.                   (equal (cadr w) pi 1e-6)
275.                   (equal (cadr w) (* 1.5 pi) 1e-6)
276.                   (equal (cadr w) (* 2 pi) 1e-6)
277.                 )
278.               ))
279.               lwdd
280.             )
281.           )
282.           (setq lws (vl-remove lw lws) lwso (cons lw lwso))
283.         )
284.         ( (and
285.             (not orth)
286.             (vl-every
287.               (function (lambda ( w )
288.                 (or
289.                   (equal (cadr w) 0.0 1e-6)
290.                   (equal (cadr w) (* 0.5 pi) 1e-6)
291.                   (equal (cadr w) pi 1e-6)
292.                   (equal (cadr w) (* 1.5 pi) 1e-6)
293.                   (equal (cadr w) (* 2 pi) 1e-6)
294.                 )
295.               ))
296.               lwdd
297.             )
298.           )
299.           (setq lws (vl-remove lw lws))
300.         )
301.       )
302.     )
303.     (setq lwd (process lws (length lws) nil orth (not chk)))
304.     (if orth
305.       (progn
306.         (setq lwd (process (list (setq q (car (vl-sort lwso (function (lambda ( a b ) (< (vlax-curve-getarea a) (vlax-curve-getarea b)))))))) 2 lwd orth (not chk)))
307.         (setq lwds (caddr lwd))
308.         (setq lwso (vl-remove q lwso))
309.         (while
310.           (or
311.             (setq lwww (vl-some (function (lambda ( z / xx ) (if (and (setq xx (vl-some (function (lambda ( a ) (vl-some (function (lambda ( x ) (if (equal (distance (car a) (caddr a)) (distance (car x) (caddr x)) 1e-6) (list x a)))) (apply (function append) (mapcar (function inspectlw) lws))))) (apply (function append) (mapcar (function inspectlw) lwso)))) (vl-some (function (lambda ( b ) (vl-some (function (lambda ( y ) (and (not (equal b (car xx) 1e-6)) (not (equal b (cadr xx) 1e-6)) (not (equal y (car xx) 1e-6)) (not (equal y (cadr xx) 1e-6)) (equal (distance (car b) (caddr b)) (distance (car y) (caddr y)) 1e-6)))) (apply (function append) (mapcar (function inspectlw) lws))))) (apply (function append) (mapcar (function inspectlw) lwso)))) z))) (mapcar (function inspectlw) lwso)))
312.             (car lwso)
313.           )
314.           (if (cdr lwso)
315.             (foreach w lwso
316.               (if (equal (inspectlw w) lwww 1e-6)
317.                 (progn
318.                   (if (listclockwise-p (mapcar (function cdr) (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) (entget w))))
319.                     (setq lwd (process (list w) 2 (cons lwds lwd) orth (not chk)))
320.                     (setq lwd (process (list w) 2 lwd orth (not chk)))
321.                   )
322.                   (setq lwso (vl-remove w lwso))
323.                 )
324.               )
325.             )
326.             (progn
327.               (process (list (car lwso)) 2 lwd orth chk)
328.               (setq lwso nil)
329.             )
330.           )
331.         )
332.       )
333.     )
334.   )
335.  
336.   (if (= 8 (logand 8 (getvar (quote undoctl))))
337.     (if command-s
338.       (command-s "_.UNDO" "_E")
339.       (vl-cmdf "_.UNDO" "_E")
340.     )
341.   )
342.   (if command-s
343.     (command-s "_.UNDO" "_M")
344.     (vl-cmdf "_.UNDO" "_M")
345.   )
346.   (initget "Yes No")
347.   (setq orth (cond ( (getkword "\nEnable ortho or not [Yes / No] <Yes> : ") ) ( "Yes" ) ))
348.   (if (= orth "Yes")
349.     (setq orth t)
350.     (setq orth nil)
351.   )
352.   (initget "Yes No")
353.   (setq chk (cond ( (getkword "\nChoose check for ortho - if it stals choose \"No\" next time [Yes / No] <Yes> : ") ) ( "Yes" ) ))
354.   (if (= chk "Yes")
355.     (setq chk t)
356.     (setq chk nil)
357.   )
358.   (prompt "\nSelect polygons you want CW - orthogonal - right side <ENTER - CONTINUE> : ")
359.   (if (setq s (ssget "_:L" (list (cons 0 "LWPOLYLINE") (cons -4 "&") (cons 70 1) (cons -4 "<NOT") (cons -4 "<>") (cons 42 0.0) (cons -4 "NOT>"))))
360.     (foreach lw (vl-remove-if (function listp) (mapcar (function cadr) (ssnamex s)))
361.       (if (not (listclockwise-p (mapcar (function cdr) (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) (entget lw)))))
362.         (rlw lw)
363.       )
364.     )
365.   )
366.   (prompt "\nSelect polygons you want CCW - non orthogonal + upper side orthogonal <ENTER - CONTINUE> : ")
367.   (if (setq s (ssget "_:L" (list (cons 0 "LWPOLYLINE") (cons -4 "&") (cons 70 1) (cons -4 "<NOT") (cons -4 "<>") (cons 42 0.0) (cons -4 "NOT>"))))
368.     (foreach lw (vl-remove-if (function listp) (mapcar (function cadr) (ssnamex s)))
369.       (if (listclockwise-p (mapcar (function cdr) (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) (entget lw))))
370.         (rlw lw)
371.       )
372.     )
373.   )
374.   (prompt "\nSelect polygonal LWPOLYLINE(s) on unlocked Layer(s)...")
375.   (if (setq ss (ssget "_:L" (list (cons 0 "LWPOLYLINE") (cons -4 "&") (cons 70 1) (cons -4 "<NOT") (cons -4 "<>") (cons 42 0.0) (cons -4 "NOT>"))))
376.     (progn
377.       (repeat (setq i (sslength ss))
378.         (setq lws (cons (ssname ss (setq i (1- i))) lws))
379.       )
380.       (jigsaw lws orth chk)
381.     )
382.   )
383.   (*error* nil)
384. )
385.  

M.R.

[ribarm]

I am attaching relevant *.dwg for you to see how it is working... The code was altered many times, but now it's just the way it was thought to be...

Code - Auto/Visual Lisp: [Select]

1. (defun c:jigsaw-ortho ( / *error* listclockwise-p rlw bb jigsaw s ss i lws lwss orth base cent c lll qqq qqqlr qqqul ddd )
2.  
3.   (vl-load-com)
4.  
5.   (defun *error* ( m )
6.     (if (= 8 (logand 8 (getvar (quote undoctl))))
7.       (if command-s
8.         (command-s "_.UNDO" "_E")
9.         (vl-cmdf "_.UNDO" "_E")
10.       )
11.     )
12.     (if m
13.       (prompt m)
14.     )
15.     (princ)
16.   )
17.  
18.   (defun listclockwise-p ( lst )
19.     ;; by Lee Mac
20.     (minusp
21.       (apply (function +)
22.         (mapcar
23.           (function (lambda ( a b )
24.             (- (* (car b) (cadr a)) (* (car a) (cadr b)))
25.           ))
26.           lst
27.           (cons (last lst) lst)
28.         )
29.       )
30.     )
31.   )
32.  
33.   (defun rlw ( lw / e x1 x2 x3 x4 x5 x6 )
34.     ;; by Elpanov Evgeniy
35.     (if (= (cdr (assoc 0 (setq e (entget lw)))) "LWPOLYLINE")
36.       (progn
37.         (foreach a1 e
38.           (cond
39.             ( (= (car a1) 10) (setq x2 (cons a1 x2)) )
40.             ( (= (car a1) 40) (setq x4 (cons (cons 41 (cdr a1)) x4)) )
41.             ( (= (car a1) 41) (setq x3 (cons (cons 40 (cdr a1)) x3)) )
42.             ( (= (car a1) 42) (setq x5 (cons (cons 42 (- (cdr a1))) x5)) )
43.             ( (= (car a1) 210) (setq x6 (cons a1 x6)) )
44.             ( t (setq x1 (cons a1 x1)) )
45.           )
46.         )
47.         (entmod
48.           (append
49.             (reverse x1)
50.             (append
51.               (apply (function append)
52.                 (apply (function mapcar)
53.                   (cons (function list)
54.                     (list
55.                       x2
56.                       (cdr (reverse (cons (car x3) (reverse x3))))
57.                       (cdr (reverse (cons (car x4) (reverse x4))))
58.                       (cdr (reverse (cons (car x5) (reverse x5))))
59.                     )
60.                   )
61.                 )
62.               )
63.               x6
64.             )
65.           )
66.         )
67.         (entupd lw)
68.       )
69.     )
70.   )
71.  
72.   (defun bb ( ptlst )
73.     (list
74.       (list (apply (function min) (mapcar (function car) ptlst)) (apply (function min) (mapcar (function cadr) ptlst)))
75.       (list (apply (function max) (mapcar (function car) ptlst)) (apply (function min) (mapcar (function cadr) ptlst)))
76.       (list (apply (function max) (mapcar (function car) ptlst)) (apply (function max) (mapcar (function cadr) ptlst)))
77.       (list (apply (function min) (mapcar (function car) ptlst)) (apply (function max) (mapcar (function cadr) ptlst)))
78.     )
79.   )
80.  
81.   (defun jigsaw ( lws orth / inspectlw process lw lww lwww lwso lwd lwdd lwwd lwds q )
82.  
83.     (defun inspectlw ( lw base / lwx pts p0 angs edgs )
84.       (setq lwx (entget lw))
85.       (setq pts (mapcar (function cdr) (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) lwx)))
86.       (setq p0 (car pts))
87.       (foreach p1 (cdr pts)
88.         (cond
89.           ( (= base "ll")
90.             (if
91.               (or
92.                 (< (cadr p1) (cadr p0))
93.                 (and (= (cadr p1) (cadr p0)) (< (car p1) (car p0)))
94.               )
95.               (setq p0 p1)
96.             )
97.           )
98.           ( (= base "lr")
99.             (if
100.               (or
101.                 (< (cadr p1) (cadr p0))
102.                 (and (= (cadr p1) (cadr p0)) (> (car p1) (car p0)))
103.               )
104.               (setq p0 p1)
105.             )
106.           )
107.           ( (= base "ur")
108.             (if
109.               (or
110.                 (> (cadr p1) (cadr p0))
111.                 (and (= (cadr p1) (cadr p0)) (> (car p1) (car p0)))
112.               )
113.               (setq p0 p1)
114.             )
115.           )
116.           ( (= base "ul")
117.             (if
118.               (or
119.                 (> (cadr p1) (cadr p0))
120.                 (and (= (cadr p1) (cadr p0)) (< (car p1) (car p0)))
121.               )
122.               (setq p0 p1)
123.             )
124.           )
125.         )
126.       )
127.       (setq pts (append (member p0 pts) (reverse (cdr (member p0 (reverse pts))))))
128.       (setq angs (mapcar (function (lambda ( a b ) (angle a b))) pts (append (cdr pts) (list (car pts)))))
129.       (setq edgs (mapcar (function (lambda ( p1 a p2 ) (list p1 a p2))) pts angs (append (cdr pts) (list (car pts)))))
130.     )
131.  
132.     (defun process ( lws n lwd )
133.       (cond
134.         ( (and (setq lw (if (= c "Yes") cent (if qqq (car qqq) (car lws)))) (not lwd))
135.           (setq lws (vl-remove lw lws) lwd (inspectlw lw base))
136.         )
137.         ( (and lwd (= c "Yes"))
138.           (setq lll (inspectlw cent base))
139.           (setq lwd (append (inspectlw (rlw cent) base) (vl-remove-if (function (lambda ( x ) (vl-some (function (lambda ( y ) (equal x y 1e-6))) lll))) lwd)))
140.         )
141.       )
142.       (while (> n 1)
143.         (foreach lww lws
144.           (if lww
145.             (setq lwwd (inspectlw lww base))
146.           )
147.           (if ddd
148.             (setq lwd (append ddd (vl-remove-if (function (lambda ( x ) (vl-some (function (lambda ( y ) (equal x y 1e-6))) ddd))) lwd)))
149.           )
150.           (vl-some
151.             (function (lambda ( edg1 )
152.               (vl-some
153.                 (function (lambda ( edg2 )
154.                   (if
155.                     (and
156.                       (equal (distance (car edg1) (caddr edg1)) (distance (car edg2) (caddr edg2)) 1e-6)
157.                       (or
158.                         (equal (cadr edg1) (cadr edg2) 1e-6)
159.                         (equal (rem (+ (cadr edg1) pi) (+ pi pi)) (rem (+ (cadr edg2) pi pi) (+ pi pi)) 1e-6)
160.                         (equal (rem (+ (cadr edg1) pi pi) (+ pi pi)) (rem (+ (cadr edg2) pi) (+ pi pi)) 1e-6)
161.                       )
162.                     )
163.                     (progn
164.                       (setq lws (vl-remove lww lws) n (1- n))
165.                       (cond
166.                         ( (equal (cadr edg1) (cadr edg2) 1e-6)
167.                           (vla-move (vlax-ename->vla-object lww) (vlax-3d-point (car edg2)) (vlax-3d-point (car edg1)))
168.                           (foreach x lwwd
169.                             (if (not (equal edg2 x 1e-6))
170.                               (progn
171.                                 (setq xx (subst (mapcar (function +) (mapcar (function -) (car edg1) (car edg2)) (car x)) (car x) x))
172.                                 (setq xx (subst (mapcar (function +) (mapcar (function -) (car edg1) (car edg2)) (caddr xx)) (caddr xx) xx))
173.                                 (setq lwd (cons xx lwd))
174.                               )
175.                             )
176.                           )
177.                           (setq lwd (vl-remove edg1 lwd))
178.                         )
179.                         ( (or
180.                             (equal (rem (+ (cadr edg1) pi) (+ pi pi)) (rem (+ (cadr edg2) pi pi) (+ pi pi)) 1e-6)
181.                             (equal (rem (+ (cadr edg1) pi pi) (+ pi pi)) (rem (+ (cadr edg2) pi) (+ pi pi)) 1e-6)
182.                           )
183.                           (vla-move (vlax-ename->vla-object lww) (vlax-3d-point (caddr edg2)) (vlax-3d-point (car edg1)))
184.                           (foreach x lwwd
185.                             (if (not (equal edg2 x 1e-6))
186.                               (progn
187.                                 (setq xx (subst (mapcar (function +) (mapcar (function -) (car edg1) (caddr edg2)) (car x)) (car x) x))
188.                                 (setq xx (subst (mapcar (function +) (mapcar (function -) (car edg1) (caddr edg2)) (caddr xx)) (caddr xx) xx))
189.                                 (setq lwd (cons xx lwd))
190.                               )
191.                             )
192.                           )
193.                           (setq lwd (vl-remove edg1 lwd))
194.                         )
195.                       )
196.                     )
197.                   )
198.                 ))
199.                 lwwd
200.               )
201.             ))
202.             lwd
203.           )
204.         )
205.       )
206.       lwd
207.     )
208.  
209.     (if (not orth)
210.       (setq lwd (process lwss (length lwss) nil))
211.       (progn
212.         (if (> (length qqq) 1)
213.           (setq ddd (process qqq (length qqq) nil))
214.         )
215.         (setq lwd (process qqqlr (length qqqlr) lwd))
216.         (setq lwd (process qqqul (length qqqul) lwd))
217.         (setq lwso (vl-remove-if (function (lambda ( x ) (vl-some (function (lambda ( y ) (eq x y))) (append qqq qqqlr qqqul)))) lwss))
218.         (setq qqqbb (bb (apply (function append) (mapcar (function (lambda ( q ) (mapcar (function cdr) (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) (entget q))))) (append qqq qqqlr qqqul)))))
219.         (setq centbb (bb (if (= c "Yes") (mapcar (function cdr) (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) (entget cent))) (apply (function append) (mapcar (function (lambda ( x ) (mapcar (function cdr) (vl-remove-if (function (lambda ( y ) (/= (car y) 10))) (entget x))))) qqq)))))
220.         (foreach lw lwso
221.           (setq lwbb (bb (mapcar (function cdr) (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) (entget lw)))))
222.           (cond
223.             ( (equal (distance (car qqqbb) (car centbb)) (distance (car lwbb) (caddr lwbb)) 1e-6)
224.               (vla-move (vlax-ename->vla-object lw) (vlax-3d-point (caddr lwbb)) (vlax-3d-point (car centbb)))
225.             )
226.             ( (equal (distance (cadr qqqbb) (cadr centbb)) (distance (cadr lwbb) (cadddr lwbb)) 1e-6)
227.               (vla-move (vlax-ename->vla-object lw) (vlax-3d-point (cadddr lwbb)) (vlax-3d-point (cadr centbb)))
228.             )
229.             ( (equal (distance (caddr qqqbb) (caddr centbb)) (distance (caddr lwbb) (car lwbb)) 1e-6)
230.               (vla-move (vlax-ename->vla-object lw) (vlax-3d-point (car lwbb)) (vlax-3d-point (caddr centbb)))
231.             )
232.             ( (equal (distance (cadddr qqqbb) (cadddr centbb)) (distance (cadddr lwbb) (cadr lwbb)) 1e-6)
233.               (vla-move (vlax-ename->vla-object lw) (vlax-3d-point (cadr lwbb)) (vlax-3d-point (cadddr centbb)))
234.             )
235.           )
236.         )
237.       )
238.     )
239.   )
240.  
241.   (if (= 8 (logand 8 (getvar (quote undoctl))))
242.     (if command-s
243.       (command-s "_.UNDO" "_E")
244.       (vl-cmdf "_.UNDO" "_E")
245.     )
246.   )
247.   (if command-s
248.     (command-s "_.UNDO" "_M")
249.     (vl-cmdf "_.UNDO" "_M")
250.   )
251.   (initget "Yes No")
252.   (setq orth (cond ( (getkword "\nEnable orthogonal shapes for some pieces [Yes / No] <Yes> : ") ) ( "Yes" ) ))
253.   (if (= orth "Yes")
254.     (setq orth t)
255.     (setq orth nil)
256.   )
257.   (if orth
258.     (progn
259.       (prompt "\nSelect polygons you want CCW - adjacent orthogonal sides (left and up ones) <ENTER - CONTINUE> : ")
260.       (if (setq s (ssget "_:L" (list (cons 0 "LWPOLYLINE") (cons -4 "&") (cons 70 1) (cons -4 "<NOT") (cons -4 "<>") (cons 42 0.0) (cons -4 "NOT>"))))
261.         (foreach lw (vl-remove-if (function listp) (mapcar (function cadr) (ssnamex s)))
262.           (if (listclockwise-p (mapcar (function cdr) (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) (entget lw))))
263.             (rlw lw)
264.           )
265.           (setq qqqul (cons lw qqqul))
266.         )
267.       )
268.       (prompt "\nSelect polygons you want CW - adjacent orthogonal sides (right and down ones) <ENTER - CONTINUE> : ")
269.       (if (setq s (ssget "_:L" (list (cons 0 "LWPOLYLINE") (cons -4 "&") (cons 70 1) (cons -4 "<NOT") (cons -4 "<>") (cons 42 0.0) (cons -4 "NOT>"))))
270.         (foreach lw (vl-remove-if (function listp) (mapcar (function cadr) (ssnamex s)))
271.           (if (not (listclockwise-p (mapcar (function cdr) (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) (entget lw)))))
272.             (rlw lw)
273.           )
274.           (setq qqqlr (cons lw qqqlr))
275.         )
276.       )
277.       (initget "Yes No")
278.       (setq c (cond ( (getkword "\nDo you have central piece, or many central pieces [Yes / No] <Yes> : ") ) ( "Yes" )))
279.       (if (= c "Yes")
280.         (progn
281.           (while (not (setq cent (car (entsel "\nPick central ortho piece..."))))
282.             (prompt "\nMissed...")
283.           )
284.           (if (listclockwise-p (mapcar (function cdr) (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) (entget cent))))
285.             (rlw cent)
286.           )
287.           (setq qqq (cons cent qqq))
288.         )
289.         (progn
290.           (prompt "\nSelect central pieces non orthogonal...")
291.           (if (setq ss (ssget "_:L" (list (cons 0 "LWPOLYLINE") (cons -4 "&") (cons 70 1) (cons -4 "<NOT") (cons -4 "<>") (cons 42 0.0) (cons -4 "NOT>"))))
292.             (repeat (setq i (sslength ss))
293.               (setq lw (ssname ss (setq i (1- i))))
294.               (if (listclockwise-p (mapcar (function cdr) (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) (entget lw))))
295.                 (rlw lw)
296.               )
297.               (setq qqq (cons lw qqq))
298.             )
299.           )
300.         )
301.       )
302.     )
303.   )
304.   ;|
305.   (initget 1 "ll lr ur ul")
306.   (setq base (getkword "\nChoose basepoint orientation [ll / lr / ur / ul] : "))
307.   |;
308.   (setq base "ll")
309.   (prompt "\nSelect polygonal LWPOLYLINE(s) on unlocked Layer(s)...")
310.   (if (setq ss (ssget "_:L" (list (cons 0 "LWPOLYLINE") (cons -4 "&") (cons 70 1) (cons -4 "<NOT") (cons -4 "<>") (cons 42 0.0) (cons -4 "NOT>"))))
311.     (progn
312.       (repeat (setq i (sslength ss))
313.         (setq lws (cons (ssname ss (setq i (1- i))) lws))
314.       )
315.       (setq lwss lws)
316.       (if (= c "Yes")
317.         (progn
318.           (setq lws (vl-remove cent lws))
319.           (setq lws (cons cent lws))
320.         )
321.       )
322.       (if (not orth)
323.         (if (or (= base "ll") (= base "lr"))
324.           (foreach lw lws
325.             (if (listclockwise-p (mapcar (function cdr) (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) (entget lw))))
326.               (rlw lw)
327.             )
328.           )
329.           (foreach lw lws
330.             (if (not (listclockwise-p (mapcar (function cdr) (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) (entget lw)))))
331.               (rlw lw)
332.             )
333.           )
334.         )
335.       )
336.       (jigsaw lws orth)
337.     )
338.   )
339.   (*error* nil)
340. )
341.  

M.R.

[ribarm]

I think that that's it...
Posted code worked in any case of jigsaw.dwg...
Updated code is here : https://www.theswamp.org/index.php?topic=44783.msg613820#msg613820

Thanks for attention,
M.R.

[ribarm]

Just wanted to show how it's working...