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

[pBe]

Try to put me back together: [jigsaw--<< straight segments>>--]
EDIT: Guess to make it easier. the four corner points should be defined...... or Width and Length is given....
Also note that none of the pieces are rotated. now thats one less thing to worry about 


Re-writing code..... 19June2013

Code: [Select]

..............................


[pBe]

PSEUDO CODE:

Select objects:
Get Length and Width ;<--- still not sure...  Get LL and UR [getpoint/getcorner] to determine coordinates for corners + L and W.
Extract object coordinates
Extract Boundingbox
Build upper left and lower right points
Determine object direction [C/CCW]
Capture objects for 4 corners starting with LL clockwise direction
Remove captured pieces from list
Iterate thru remaining pieces to determine matching piece from lower left corner clockwise direction
Starting with objects with segments at angle 90, 0, 270 and 180 respectively

[Lee Mac]

A difficult challenge... 

This is terrible coding, but should get somewhere near:

Code: [Select]

(defun c:jigsaw ( / ang ent idx itm lst pcs sel tmp vtx )

    (defun vertices ( ent )
        (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) (entget ent)))
    )   
    (if (setq sel (ssget "_:L" '((0 . "LWPOLYLINE") (-4 . "&=") (70 . 1))))
        (progn
            (repeat (setq idx (sslength sel))
                (setq ent (ssname sel (setq idx (1- idx)))
                      vtx (vertices ent)
                      ang (mapcar 'LM:getleftangle (cons (last vtx) vtx) vtx (append (cdr vtx) (list (car vtx))))
                )
                (if (< (apply '+ (setq tmp (mapcar '(lambda ( x ) (- (+ pi pi) x)) ang))) (apply '+ ang))
                    (setq ang tmp)
                )
                (setq lst (cons (cons ent (mapcar 'cons ang vtx)) lst))
            )
            (setq pcs (cdar lst)
                  lst (cdr lst)
                  tmp nil
            )
            (while
                (progn
                    (foreach itm lst
                        (if
                            (not
                                (vl-some
                                    (function
                                        (lambda ( a )
                                            (vl-some
                                                (function
                                                    (lambda ( b / x )
                                                        (setq x (rem (+ (car a) (car b)) pi))
                                                        (if (or (equal x 0.0 1e-8) (equal x pi 1e-8))
                                                            (progn
                                                                (vl-cmdf "_.move" (car itm) "" "_non" (cdr a) "_non" (cdr b))
                                                                (setq pcs (append (mapcar '(lambda ( a b ) (cons (car a) b)) (cdr itm) (vertices (car itm))) pcs))
                                                            )
                                                        )
                                                    )
                                                )
                                                pcs
                                            )
                                        )
                                    )
                                    (cdr itm)
                                )
                            )
                            (setq tmp (cons itm tmp))
                        )
                    )
                    tmp
                )
                (setq pcs (cdar tmp)
                      lst (cdr tmp)
                      tmp nil
                )
            )
        )
    )
    (princ)
)

;; Get Left Angle  -  Lee Mac
;; Returns the angle swept by rotating the vector (p2,p1) clockwise to (p2,p3)

(defun LM:getleftangle ( p1 p2 p3 )
    (rem (+ pi pi (- (angle p2 p1) (angle p2 p3))) (+ pi pi))
)

(vl-load-com) (princ)

[pBe]

First Entry is from Lee Mac.
I honestly have not tried your code yet LM . I'll post mine later or tomrw. i hit a snag on the last piece. Makes me wonder how difficult it will be if there are more pieces located on the middle of the jigsaw.
Thank you for the submission LM.
Cheers 
 
 

[Lee Mac]

Cheers pBe 

The key to the challenge is to first calculate the interior angles for every vertex of every piece, and then compare every group of two, three, four, ... ,n vertices (where n is the number of pieces) to find those groups of angles which sum to either 2π (or π radians for edge pieces). If such a group is found, move the pieces such that the vertices contributing to the angle sum coincide.

The pieces that have been moved would then need to be collected in a separate set to ensure that pieces in the candidate set are moved to form the jigsaw and tesselating pieces are unaltered.

My current program follows this method, however, only comparing pairs of pieces.

[pBe]

Cheers pBe 

The key to the challenge is to first calculate the interior angles.........
My current program follows this method, however, only comparing pairs of pieces.

Cool. oops. I shouldn't be reading this till i finish my own routine .   

I'll keep that in mind....

Cheers

[ribarm]

I only want to locate lower-left polyline, but there is some bug in my code... Please, if you know how to debug it correctly... By my research incrementation isn't working in my 2 last subfunctions...

Code: [Select]

(defun c:putmetogether ( / AssocOn LM:ListClockwise-p member-fuzz plvlst llchk prevang nextang suppang anglst dstlst mdpairs reversess llwidchk lllenchk
                           p1 p2 vec ss ssss1 ssss2 ssss3 ssss4 ssss5 wid len i pl vlst llpls llpl )

  (vl-load-com)

  (defun AssocOn ( SearchTerm Lst func fuzz )
    (car
      (vl-member-if
        (function
          (lambda (pair) (equal SearchTerm (apply func (list pair)) fuzz))
        )
        lst
      )
    )
  )

  (defun LM:ListClockwise-p ( lst )
    (minusp
      (apply '+
        (mapcar
          (function
            (lambda ( a b )
              (- (* (car b) (cadr a)) (* (car a) (cadr b)))
            )
          ) lst (cons (last lst) lst)
        )
      )
    )
  )

  (defun member-fuzz ( expr lst fuzz )
    (while (and lst (not (equal (car lst) expr fuzz)))
      (setq lst (cdr lst))
    )
    lst
  )

  (defun plvlst ( pl / vlst pt ptlst )
    (setq vlst (vlax-safearray->list (vlax-variant-value (vla-get-coordinates (vlax-ename->vla-object pl)))))
    (cond
      ( (eq (vla-get-objectname (vlax-ename->vla-object pl)) "AcDbPolyline")
        (repeat (/ (length vlst) 2)
          (setq pt (list (car vlst) (cadr vlst)))
          (setq vlst (cddr vlst))
          (setq ptlst (cons pt ptlst))
        )
        (mapcar '(lambda (x) (trans x 0 1)) (reverse ptlst))
      )
      ( (eq (vla-get-objectname (vlax-ename->vla-object pl)) "AcDb2dPolyline")
        (repeat (/ (length vlst) 3)
          (setq pt (list (car vlst) (cadr vlst)))
          (setq vlst (cdddr vlst))
          (setq ptlst (cons pt ptlst))
        )
        (mapcar '(lambda (x) (trans x 0 1)) (reverse ptlst))
      )
    )
  )

  (defun llchk ( lst / tst )
    (mapcar '(lambda (a b c)
               (if (and (equal (angle a b) 0.0 1e-6) (equal (angle c a) (* 1.5 pi) 1e-6)) (setq tst (cons T tst)) (setq tst (cons nil tst)))
             )
             lst
             (append (cdr lst) (list (car lst)))
             (append (list (last lst)) (reverse (cdr (reverse lst))))
    )
    (eval (cons 'or tst))
  )

  (defun prevang ( ang lst / alst )
    (setq alst (anglst lst))
    (cond
      ( (equal ang (car alst) 1e-6)
        (last alst)
      )
      ( (equal ang (last alst) 1e-6)
        (cadr (reverse alst))
      )
      ( (cadr (member-fuzz ang (reverse alst) 1e-6)) )
    )
  )

  (defun nextang ( ang lst / alst )
    (setq alst (anglst lst))
    (cond
      ( (equal ang (car alst) 1e-6)
        (cadr alst)
      )
      ( (equal ang (last alst) 1e-6)
        (car alst)
      )
      ( (cadr (member-fuzz ang alst 1e-6)) )
    )
  )

  (defun suppang ( ang )
    (cond
      ( (< 0.0 ang pi)
        (+ ang pi)
      )
      ( (< pi ang (* 2.0 pi))
        (- ang pi)
      )
      ( (equal ang pi 1e-8)
        0.0
      )
      ( (or (equal ang 0.0 1e-8) (equal ang (* 2.0 pi) 1e-8))
        pi
      )
    )
  )

  (defun anglst ( lst / alst )
    (setq alst (mapcar '(lambda (a b) (angle a b)) lst (append (cdr lst) (list (car lst)))))
  )

  (defun dstlst ( lst / dlst )
    (setq dlst (mapcar '(lambda (a b) (distance a b)) lst (append (cdr lst) (list (car lst)))))
  )

  (defun mdpairs ( lst1 lst2 )
    (mapcar '(lambda (a b) (cons a b)) lst1 lst2)
  )

  (defun reversess ( s / sssss i ent )
    (gc)
    (setq sssss (ssadd))
    (repeat (setq i (sslength s))
      (setq ent (ssname s (setq i (1- i))))
      (ssadd ent sssss)
    )
    sssss
  )

  (defun llwidchk ( llpl sss wid / loop i plin pln plnwid )
    (if (not vlstw) (setq vlstw (plvlst llpl)))
    (if (not alstw) (setq alstw (anglst vlstw)))
    (if (not angn) (setq angn (nextang 0.0 vlstw)))
    (if (not suppangn) (setq suppangn (suppang angn)))
    (if (not llplwid) (setq llplwid (cdr (assocon 0.0 (mdpairs alstw (dstlst vlstw)) 'car 1e-6))))
    (if (not lwid) (setq lwid llplwid))
    (if (not dstchk1) (setq dstchk1 (cdr (assocon angn (mdpairs alstw (dstlst vlstw)) 'car 1e-6))))
    (setq i -1)
    (setq loop T)
    (if (equal lwid wid 1e-6) (setq chk T loop nil))
    (while (and (setq plin (if sss (ssname sss (setq i (1+ i))) nil)) loop)
      (if (member-fuzz suppangn (anglst (plvlst plin)) 1e-6)
        (setq pln plin)
      )
      (if pln
        (progn
          (setq plnwid (cdr (assocon 0.0 (mdpairs (anglst (plvlst pln)) (dstlst (plvlst pln))) 'car 1e-6))
                dstchk2 (cdr (assocon suppangn (mdpairs (anglst (plvlst pln)) (dstlst (plvlst pln))) 'car 1e-6))
          )
          (setq vlstw (plvlst pln) alstw (anglst vlstw) angn (if (not (equal (nextang suppangn vlstw) 0.0 1e-6)) (nextang suppangn vlstw) (nextang 0.0 vlstw)))
          (if (equal dstchk1 dstchk2 1e-6)
            (setq suppangn (suppang angn) dstchk1 (cdr (assocon angn (mdpairs (anglst (plvlst pln)) (dstlst (plvlst pln))) 'car 1e-6)))
            (setq plnwid nil)
          )
        )
      )
      (if plnwid
        (progn
          (setq lwid (+ lwid plnwid))
          (cond
            ( (equal lwid wid 1e-6)
              (setq chk T loop nil)
            )
            ( (< lwid wid)
              (llwidchk nil (ssdel pln sss) wid)
              (if (equal lwid wid 1e-6) (setq chk T loop nil))
            )
            ( (> lwid wid)
              (setq chk nil loop nil)
            )
          )
        )
        (if (and pln (< lwid wid))
          (progn
            (llwidchk nil (ssdel pln sss) wid)
            (if (equal lwid wid 1e-6) (setq chk T loop nil))
          )
          (cond
            ( (equal lwid wid 1e-6)
              (setq chk T loop nil)
            )
            ( (> lwid wid)
              (setq chk nil loop nil)
            )
          )
        )
      )
    )
    chk
  )

  (defun lllenchk ( llpl sss len / loop i plin plp plplen )
    (if (not vlstl) (setq vlstl (plvlst llpl)))
    (if (not alstl) (setq alstl (anglst vlstl)))
    (if (not angp) (setq angp (prevang (* 1.5 pi) vlstl)))
    (if (not suppangp) (setq suppangp (suppang angp)))
    (if (not llpllen) (setq llpllen (cdr (assocon (* 1.5 pi) (mdpairs alstl (dstlst vlstl)) 'car 1e-6))))
    (if (not llen) (setq llen llpllen))
    (if (not dstchk1) (setq dstchk1 (cdr (assocon angp (mdpairs alstl (dstlst vlstl)) 'car 1e-6))))
    (setq i -1)
    (setq loop T)
    (if (equal llen len 1e-6) (setq chk T loop nil))
    (while (and (setq plin (if sss (ssname sss (setq i (1+ i))) nil)) loop)
      (if (member-fuzz suppangp (anglst (plvlst plin)) 1e-6)
        (setq plp plin)
      )
      (if plp
        (progn
          (setq plplen (cdr (assocon (* 1.5 pi) (mdpairs (anglst (plvlst plp)) (dstlst (plvlst plp))) 'car 1e-6))
                dstchk2 (cdr (assocon suppangp (mdpairs (anglst (plvlst plp)) (dstlst (plvlst plp))) 'car 1e-6))
          )
          (setq vlstl (plvlst plp) alstl (anglst vlstl) angp (if (not (equal (prevang suppangp vlstl) (* 1.5 pi) 1e-6)) (prevang suppangp vlstl) (prevang (* 1.5 pi) vlstl)))
          (if (equal dstchk1 dstchk2 1e-6)
            (setq suppangp (suppang angp) dstchk1 (cdr (assocon angp (mdpairs (anglst (plvlst plp)) (dstlst (plvlst plp))) 'car 1e-6)))
            (setq plplen nil)
          )
        )
      )
      (if plplen
        (progn
          (setq llen (+ llen plplen))
          (cond
            ( (equal llen len 1e-6)
              (setq chk T loop nil)
            )
            ( (< llen len)
              (lllenchk nil (ssdel plp sss) len)
              (if (equal llen len 1e-6) (setq chk T loop nil))
            )
            ( (> llen len)
              (setq chk nil loop nil)
            )
          )
        )
        (if (and plp (< llen len))
          (progn
            (lllenchk nil (ssdel plp sss) len)
            (if (equal llen len 1e-6) (setq chk T loop nil))
          )
          (cond
            ( (equal llen len 1e-6)
              (setq chk T loop nil)
            )
            ( (> llen len)
              (setq chk nil loop nil)
            )
          )
        )
      )
    )
    chk
  )

  (setq ss (ssget "_:L" '((0 . "*POLYLINE") (-4 . "&=") (70 . 1))))
  (setq p1 (getpoint "\nPick start corner : "))
  (setq p2 (getcorner p1 "\nPick end corner : "))
  (setq vec (mapcar '- p2 p1))
  (setq wid (abs (car vec)))
  (setq len (abs (cadr vec)))
  (setq ssss1 (ssadd) ssss2 (ssadd) ssss3 (ssadd) ssss4 (ssadd) ssss5 (ssadd))
  (setq i -1)
  (while (setq pl (ssname ss (setq i (1+ i))))
    (setq vlst (plvlst pl))
    (if (LM:ListClockwise-p vlst)
      (progn
        (command "_.reverse" pl "")
        (setq vlst (plvlst pl))
      )
    )
    (if (llchk vlst) (setq llpls (cons pl llpls)))
    (ssadd pl ssss1)
    (ssadd pl ssss2)
    (ssadd pl ssss3)
    (ssadd pl ssss4)
    (ssadd pl ssss5)
  )
  (foreach plll llpls
    (setq vlstw nil alstw nil angn nil suppangn nil llplwid nil lwid nil dstchk1 nil dstchk2 nil chk nil)
    (setq vlstl nil alstl nil angp nil suppangp nil llpllen nil llen nil dstchk1 nil dstchk2 nil chk nil)
    (ssdel plll ssss1)
    (ssdel plll ssss2)
    (ssdel plll ssss3)
    (ssdel plll ssss4)
    (if (and
          (or (llwidchk plll ssss1 wid) (llwidchk plll (reversess ssss2) wid))
          (or (lllenchk plll ssss3 len) (lllenchk plll (reversess ssss4) len))
        )
        (setq llpl plll)
    )
    (setq ssss1 (ssadd) ssss2 (ssadd) ssss3 (ssadd) ssss4 (ssadd))
    (setq i -1)
    (while (setq pl (ssname ssss5 (setq i (1+ i))))
      (ssadd pl ssss1)
      (ssadd pl ssss2)
      (ssadd pl ssss3)
      (ssadd pl ssss4)
    )
  )
  (setq vlstw nil alstw nil angn nil suppangn nil llplwid nil lwid nil dstchk1 nil dstchk2 nil chk nil)
  (setq vlstl nil alstl nil angp nil suppangp nil llpllen nil llen nil dstchk1 nil dstchk2 nil chk nil)
  (prompt "\nLower-left 2d polyline is highlighted")
  (sssetfirst nil (ssadd llpl))
  (princ)
)


[ribarm]

I have successfully debugged my code in certain measure... Now pBe's *dwg example is working, but my example below isn't... Please, see attached *.dwg

M.R.

[ribarm]

Updated and finally debugged code to be applicable for both cases... Still not tested in who knows what situation - it may fail...

Regards, M.R.
 

[pBe]

Cool. another entry, Am still working on mine  .

Thank you Marko. I'll try it later. Don't want someones else's idea influence the code im working on.

Cheers

[ribarm]

Also, this should be working, but if you manipulate with objects (rotate or similar) - it may fail... Also note that on scattered pieces on the left side it's working almost as it should - 3 corners are highlighted, and on the right side where are all pieces combined into one rectangle it's highlighting only one corner... I believe that this also has something to do with inaccurate calculations of (trans pt 0 1)... Fuzz factors seems are not the issue - I've checked this also...

Code - Auto/Visual Lisp: [Select]

1. (defun c:putmetogether ( / AssocOn LM:ListClockwise-p member-fuzz plvlst llchk prevang nextang suppang anglst dstlst mdpairs reversess llwidchk lllenchk
2.                            p1 p2 vec ss ssss ssss1 ssss2 ssss3 ssss4 ssss5 wid len i pl vlst llpls llpl )
3.  
4.   (vl-load-com)
5.  
6.   (defun AssocOn ( SearchTerm Lst func fuzz )
7.     (car
8.       (vl-member-if
9.         (function
10.           (lambda (pair) (equal SearchTerm (apply func (list pair)) fuzz))
11.         )
12.         lst
13.       )
14.     )
15.   )
16.  
17.   (defun LM:ListClockwise-p ( lst )
18.     (minusp
19.       (apply '+
20.         (mapcar
21.           (function
22.             (lambda ( a b )
23.               (- (* (car b) (cadr a)) (* (car a) (cadr b)))
24.             )
25.           ) lst (cons (last lst) lst)
26.         )
27.       )
28.     )
29.   )
30.  
31.   (defun member-fuzz ( expr lst fuzz )
32.     (while (and lst (not (equal (car lst) expr fuzz)))
33.       (setq lst (cdr lst))
34.     )
35.     lst
36.   )
37.  
38.   (defun plvlst ( pl / vlst pt ptlst )
39.     (setq vlst (vlax-safearray->list (vlax-variant-value (vla-get-coordinates (vlax-ename->vla-object pl)))))
40.     (cond
41.       ( (eq (vla-get-objectname (vlax-ename->vla-object pl)) "AcDbPolyline")
42.         (repeat (/ (length vlst) 2)
43.           (setq pt (list (car vlst) (cadr vlst)))
44.           (setq vlst (cddr vlst))
45.           (setq ptlst (cons pt ptlst))
46.         )
47.         (mapcar '(lambda (x) (trans x 0 1)) (reverse ptlst))
48.       )
49.       ( (eq (vla-get-objectname (vlax-ename->vla-object pl)) "AcDb2dPolyline")
50.         (repeat (/ (length vlst) 3)
51.           (setq pt (list (car vlst) (cadr vlst)))
52.           (setq vlst (cdddr vlst))
53.           (setq ptlst (cons pt ptlst))
54.         )
55.         (mapcar '(lambda (x) (trans x 0 1)) (reverse ptlst))
56.       )
57.     )
58.   )
59.  
60.   (defun llchk ( lst / tst )
61.     (mapcar '(lambda (a b c)
62.                (if (and (equal (angle a b) 0.0 1e-6) (equal (angle c a) (* 1.5 pi) 1e-6)) (setq tst (cons T tst)) (setq tst (cons nil tst)))
63.              )
64.              lst
65.              (append (cdr lst) (list (car lst)))
66.              (append (list (last lst)) (reverse (cdr (reverse lst))))
67.     )
68.     (eval (cons 'or tst))
69.   )
70.  
71.   (defun prevang ( ang lst / alst )
72.     (setq alst (anglst lst))
73.     (cond
74.       ( (equal ang (car alst) 1e-6)
75.         (last alst)
76.       )
77.       ( (equal ang (last alst) 1e-6)
78.         (cadr (reverse alst))
79.       )
80.       ( (cadr (member-fuzz ang (reverse alst) 1e-6)) )
81.     )
82.   )
83.  
84.   (defun nextang ( ang lst / alst )
85.     (setq alst (anglst lst))
86.     (cond
87.       ( (equal ang (car alst) 1e-6)
88.         (cadr alst)
89.       )
90.       ( (equal ang (last alst) 1e-6)
91.         (car alst)
92.       )
93.       ( (cadr (member-fuzz ang alst 1e-6)) )
94.     )
95.   )
96.  
97.   (defun suppang ( ang )
98.     (cond
99.       ( (< 0.0 ang pi)
100.         (+ ang pi)
101.       )
102.       ( (< pi ang (* 2.0 pi))
103.         (- ang pi)
104.       )
105.       ( (equal ang pi 1e-6)
106.         0.0
107.       )
108.       ( (or (equal ang 0.0 1e-6) (equal ang (* 2.0 pi) 1e-6))
109.         pi
110.       )
111.     )
112.   )
113.  
114.   (defun anglst ( lst / alst )
115.     (setq alst (mapcar '(lambda (a b) (angle a b)) lst (append (cdr lst) (list (car lst)))))
116.   )
117.  
118.   (defun dstlst ( lst / dlst )
119.     (setq dlst (mapcar '(lambda (a b) (distance a b)) lst (append (cdr lst) (list (car lst)))))
120.   )
121.  
122.   (defun mdpairs ( lst1 lst2 )
123.     (mapcar '(lambda (a b) (cons a b)) lst1 lst2)
124.   )
125.  
126.   (defun reversess ( s / sssss i ent )
127.     (gc)
128.     (setq sssss (ssadd))
129.     (repeat (setq i (sslength s))
130.       (setq ent (ssname s (setq i (1- i))))
131.       (ssadd ent sssss)
132.     )
133.     sssss
134.   )
135.  
136.   (defun llwidchk ( llpl sss wid / loop i plin pln plnwid )
137.     (if (not vlstw) (setq vlstw (plvlst llpl)))
138.     (if (not alstw) (setq alstw (anglst vlstw)))
139.     (if (not angn) (setq angn (nextang 0.0 vlstw)))
140.     (if (not suppangn) (setq suppangn (suppang angn)))
141.     (if (not llplwid) (setq llplwid (cdr (assocon 0.0 (mdpairs alstw (dstlst vlstw)) 'car 1e-6))))
142.     (if (not lwid) (setq lwid llplwid))
143.     (if (not dstchk1) (setq dstchk1 (cdr (assocon angn (mdpairs alstw (dstlst vlstw)) 'car 1e-6))))
144.     (setq i -1)
145.     (setq loop T)
146.     (if (equal lwid wid 1e-6) (setq chk T loop nil))
147.     (while (and (setq plin (if sss (ssname sss (setq i (1+ i))) nil)) loop)
148.       (if (member-fuzz suppangn (anglst (plvlst plin)) 1e-6)
149.         (setq pln plin)
150.       )
151.       (if pln
152.         (progn
153.           (setq plnwid (cdr (assocon 0.0 (mdpairs (anglst (plvlst pln)) (dstlst (plvlst pln))) 'car 1e-6))
154.                 dstchk2 (cdr (assocon suppangn (mdpairs (anglst (plvlst pln)) (dstlst (plvlst pln))) 'car 1e-6))
155.           )
156.           (setq vlstw (plvlst pln) alstw (anglst vlstw) angn (if (not (equal (nextang suppangn vlstw) 0.0 1e-6)) (nextang suppangn vlstw) (nextang 0.0 vlstw)))
157.           (if (equal dstchk1 dstchk2 1e-6)
158.             (setq suppangn (suppang angn) dstchk1 (cdr (assocon angn (mdpairs (anglst (plvlst pln)) (dstlst (plvlst pln))) 'car 1e-6)))
159.             (setq plnwid nil)
160.           )
161.         )
162.       )
163.       (if plnwid
164.         (progn
165.           (setq lwid (+ lwid plnwid))
166.           (cond
167.             ( (equal lwid wid 1e-6)
168.               (setq chk T loop nil)
169.             )
170.             ( (< lwid wid)
171.               (llwidchk nil (ssdel pln sss) wid)
172.               (if (equal lwid wid 1e-6) (setq chk T loop nil))
173.             )
174.             ( (> lwid wid)
175.               (setq chk nil loop nil)
176.             )
177.           )
178.         )
179.         (if (and pln (< lwid wid))
180.           (progn
181.             (llwidchk nil (ssdel pln sss) wid)
182.             (if (equal lwid wid 1e-6) (setq chk T loop nil))
183.           )
184.           (cond
185.             ( (equal lwid wid 1e-6)
186.               (setq chk T loop nil)
187.             )
188.             ( (> lwid wid)
189.               (setq chk nil loop nil)
190.             )
191.           )
192.         )
193.       )
194.     )
195.     chk
196.   )
197.  
198.   (defun lllenchk ( llpl sss len / loop i plin plp plplen )
199.     (if (not vlstl) (setq vlstl (plvlst llpl)))
200.     (if (not alstl) (setq alstl (anglst vlstl)))
201.     (if (not angp) (setq angp (prevang (* 1.5 pi) vlstl)))
202.     (if (not suppangp) (setq suppangp (suppang angp)))
203.     (if (not llpllen) (setq llpllen (cdr (assocon (* 1.5 pi) (mdpairs alstl (dstlst vlstl)) 'car 1e-6))))
204.     (if (not llen) (setq llen llpllen))
205.     (if (not dstchk1) (setq dstchk1 (cdr (assocon angp (mdpairs alstl (dstlst vlstl)) 'car 1e-6))))
206.     (setq i -1)
207.     (setq loop T)
208.     (if (equal llen len 1e-6) (setq chk T loop nil))
209.     (while (and (setq plin (if sss (ssname sss (setq i (1+ i))) nil)) loop)
210.       (if (member-fuzz suppangp (anglst (plvlst plin)) 1e-6)
211.         (setq plp plin)
212.       )
213.       (if plp
214.         (progn
215.           (setq plplen (cdr (assocon (* 1.5 pi) (mdpairs (anglst (plvlst plp)) (dstlst (plvlst plp))) 'car 1e-6))
216.                 dstchk2 (cdr (assocon suppangp (mdpairs (anglst (plvlst plp)) (dstlst (plvlst plp))) 'car 1e-6))
217.           )
218.           (setq vlstl (plvlst plp) alstl (anglst vlstl) angp (if (not (equal (prevang suppangp vlstl) (* 1.5 pi) 1e-6)) (prevang suppangp vlstl) (prevang (* 1.5 pi) vlstl)))
219.           (if (equal dstchk1 dstchk2 1e-6)
220.             (setq suppangp (suppang angp) dstchk1 (cdr (assocon angp (mdpairs (anglst (plvlst plp)) (dstlst (plvlst plp))) 'car 1e-6)))
221.             (setq plplen nil)
222.           )
223.         )
224.       )
225.       (if plplen
226.         (progn
227.           (setq llen (+ llen plplen))
228.           (cond
229.             ( (equal llen len 1e-6)
230.               (setq chk T loop nil)
231.             )
232.             ( (< llen len)
233.               (lllenchk nil (ssdel plp sss) len)
234.               (if (equal llen len 1e-6) (setq chk T loop nil))
235.             )
236.             ( (> llen len)
237.               (setq chk nil loop nil)
238.             )
239.           )
240.         )
241.         (if (and plp (< llen len))
242.           (progn
243.             (lllenchk nil (ssdel plp sss) len)
244.             (if (equal llen len 1e-6) (setq chk T loop nil))
245.           )
246.           (cond
247.             ( (equal llen len 1e-6)
248.               (setq chk T loop nil)
249.             )
250.             ( (> llen len)
251.               (setq chk nil loop nil)
252.             )
253.           )
254.         )
255.       )
256.     )
257.     chk
258.   )
259.  
260.   (command "_.ucs" "w")
261.   (setq ss (ssget "_:L" '((0 . "*POLYLINE") (-4 . "&=") (70 . 1))))
262.   (setq p1 (getpoint "\nPick start corner : "))
263.   (setq p2 (getcorner p1 "\nPick end corner : "))
264.   (setq vec (mapcar '- p2 p1))
265.   (setq wid (abs (car vec)))
266.   (setq len (abs (cadr vec)))
267.  
268.   (setq ssss (ssadd))
269.   (setq ssss1 (ssadd) ssss2 (ssadd) ssss3 (ssadd) ssss4 (ssadd) ssss5 (ssadd))
270.   (setq i -1)
271.   (command "_.ucs" "w")
272.   (while (setq pl (ssname ss (setq i (1+ i))))
273.     (setq vlst (plvlst pl))
274.     (if (LM:ListClockwise-p vlst)
275.       (progn
276.         (command "_.reverse" pl "")
277.         (setq vlst (plvlst pl))
278.       )
279.     )
280.     (if (llchk vlst) (setq llpls (cons pl llpls)))
281.     (ssadd pl ssss1)
282.     (ssadd pl ssss2)
283.     (ssadd pl ssss3)
284.     (ssadd pl ssss4)
285.     (ssadd pl ssss5)
286.   )
287.   (foreach plll llpls
288.     (setq vlstw nil alstw nil angn nil suppangn nil llplwid nil lwid nil dstchk1 nil dstchk2 nil chk nil)
289.     (setq vlstl nil alstl nil angp nil suppangp nil llpllen nil llen nil dstchk1 nil dstchk2 nil chk nil)
290.     (ssdel plll ssss1)
291.     (ssdel plll ssss2)
292.     (ssdel plll ssss3)
293.     (ssdel plll ssss4)
294.     (if (and
295.           (or (llwidchk plll ssss1 wid) (llwidchk plll (setq sss (reversess ssss2)) wid))
296.           (or (lllenchk plll ssss3 len) (lllenchk plll (setq sss (reversess ssss4)) len))
297.         )
298.         (setq llpl plll)
299.     )
300.     (setq ssss1 (ssadd) ssss2 (ssadd) ssss3 (ssadd) ssss4 (ssadd))
301.     (setq i -1)
302.     (while (setq pl (ssname ssss5 (setq i (1+ i))))
303.       (ssadd pl ssss1)
304.       (ssadd pl ssss2)
305.       (ssadd pl ssss3)
306.       (ssadd pl ssss4)
307.     )
308.   )
309.   (setq vlstw nil alstw nil angn nil suppangn nil llplwid nil lwid nil dstchk1 nil dstchk2 nil chk nil)
310.   (setq vlstl nil alstl nil angp nil suppangp nil llpllen nil llen nil dstchk1 nil dstchk2 nil chk nil)
311.   (prompt "\nLower-left 2d polyline is highlighted - ENTER TO CONTINUE")
312.   (ssadd llpl ssss)
313.   (sssetfirst nil (ssadd llpl))
314.   (setq llpls nil)
315.   (gc)
316.   (command "\\")
317.  
318.   (setq i -1)
319.   (command "_.ucs" "z" 90)
320.   (while (setq pl (ssname ss (setq i (1+ i))))
321.     (setq vlst (plvlst pl))
322.     (if (LM:ListClockwise-p vlst)
323.       (progn
324.         (command "_.reverse" pl "")
325.         (setq vlst (plvlst pl))
326.       )
327.     )
328.     (if (llchk vlst) (setq llpls (cons pl llpls)))
329.   )
330.   (foreach plll llpls
331.     (setq vlstw nil alstw nil angn nil suppangn nil llplwid nil lwid nil dstchk1 nil dstchk2 nil chk nil)
332.     (setq vlstl nil alstl nil angp nil suppangp nil llpllen nil llen nil dstchk1 nil dstchk2 nil chk nil)
333.     (ssdel plll ssss1)
334.     (ssdel plll ssss2)
335.     (ssdel plll ssss3)
336.     (ssdel plll ssss4)
337.     (if (and
338.           (or (llwidchk plll ssss1 len) (llwidchk plll (setq sss (reversess ssss2)) len))
339.           (or (lllenchk plll ssss3 wid) (lllenchk plll (setq sss (reversess ssss4)) wid))
340.         )
341.         (setq llpl plll)
342.     )
343.     (setq ssss1 (ssadd) ssss2 (ssadd) ssss3 (ssadd) ssss4 (ssadd))
344.     (setq i -1)
345.     (while (setq pl (ssname ssss5 (setq i (1+ i))))
346.       (ssadd pl ssss1)
347.       (ssadd pl ssss2)
348.       (ssadd pl ssss3)
349.       (ssadd pl ssss4)
350.     )
351.   )
352.   (setq vlstw nil alstw nil angn nil suppangn nil llplwid nil lwid nil dstchk1 nil dstchk2 nil chk nil)
353.   (setq vlstl nil alstl nil angp nil suppangp nil llpllen nil llen nil dstchk1 nil dstchk2 nil chk nil)
354.   (prompt "\nLower-right 2d polyline is highlighted - ENTER TO CONTINUE")
355.   (ssadd llpl ssss)
356.   (sssetfirst nil (ssadd llpl))
357.   (setq llpls nil)
358.   (gc)
359.   (command "\\")
360.  
361.   (setq i -1)
362.   (command "_.ucs" "z" 90)
363.   (while (setq pl (ssname ss (setq i (1+ i))))
364.     (setq vlst (plvlst pl))
365.     (if (LM:ListClockwise-p vlst)
366.       (progn
367.         (command "_.reverse" pl "")
368.         (setq vlst (plvlst pl))
369.       )
370.     )
371.     (if (llchk vlst) (setq llpls (cons pl llpls)))
372.   )
373.   (foreach plll llpls
374.     (setq vlstw nil alstw nil angn nil suppangn nil llplwid nil lwid nil dstchk1 nil dstchk2 nil chk nil)
375.     (setq vlstl nil alstl nil angp nil suppangp nil llpllen nil llen nil dstchk1 nil dstchk2 nil chk nil)
376.     (ssdel plll ssss1)
377.     (ssdel plll ssss2)
378.     (ssdel plll ssss3)
379.     (ssdel plll ssss4)
380.     (if (and
381.           (or (llwidchk plll ssss1 wid) (llwidchk plll (setq sss (reversess ssss2)) wid))
382.           (or (lllenchk plll ssss3 len) (lllenchk plll (setq sss (reversess ssss4)) len))
383.         )
384.         (setq llpl plll)
385.     )
386.     (setq ssss1 (ssadd) ssss2 (ssadd) ssss3 (ssadd) ssss4 (ssadd))
387.     (setq i -1)
388.     (while (setq pl (ssname ssss5 (setq i (1+ i))))
389.       (ssadd pl ssss1)
390.       (ssadd pl ssss2)
391.       (ssadd pl ssss3)
392.       (ssadd pl ssss4)
393.     )
394.   )
395.   (setq vlstw nil alstw nil angn nil suppangn nil llplwid nil lwid nil dstchk1 nil dstchk2 nil chk nil)
396.   (setq vlstl nil alstl nil angp nil suppangp nil llpllen nil llen nil dstchk1 nil dstchk2 nil chk nil)
397.   (prompt "\nUpper-right 2d polyline is highlighted - ENTER TO CONTINUE")
398.   (ssadd llpl ssss)
399.   (sssetfirst nil (ssadd llpl))
400.   (setq llpls nil)
401.   (gc)
402.   (command "\\")
403.  
404.   (setq i -1)
405.   (command "_.ucs" "z" 90)
406.   (while (setq pl (ssname ss (setq i (1+ i))))
407.     (setq vlst (plvlst pl))
408.     (if (LM:ListClockwise-p vlst)
409.       (progn
410.         (command "_.reverse" pl "")
411.         (setq vlst (plvlst pl))
412.       )
413.     )
414.     (if (llchk vlst) (setq llpls (cons pl llpls)))
415.   )
416.   (foreach plll llpls
417.     (setq vlstw nil alstw nil angn nil suppangn nil llplwid nil lwid nil dstchk1 nil dstchk2 nil chk nil)
418.     (setq vlstl nil alstl nil angp nil suppangp nil llpllen nil llen nil dstchk1 nil dstchk2 nil chk nil)
419.     (ssdel plll ssss1)
420.     (ssdel plll ssss2)
421.     (ssdel plll ssss3)
422.     (ssdel plll ssss4)
423.     (if (and
424.           (or (llwidchk plll ssss1 len) (llwidchk plll (setq sss (reversess ssss2)) len))
425.           (or (lllenchk plll ssss3 wid) (lllenchk plll (setq sss (reversess ssss4)) wid))
426.         )
427.         (setq llpl plll)
428.     )
429.     (setq ssss1 (ssadd) ssss2 (ssadd) ssss3 (ssadd) ssss4 (ssadd))
430.     (setq i -1)
431.     (while (setq pl (ssname ssss5 (setq i (1+ i))))
432.       (ssadd pl ssss1)
433.       (ssadd pl ssss2)
434.       (ssadd pl ssss3)
435.       (ssadd pl ssss4)
436.     )
437.   )
438.   (setq vlstw nil alstw nil angn nil suppangn nil llplwid nil lwid nil dstchk1 nil dstchk2 nil chk nil)
439.   (setq vlstl nil alstl nil angp nil suppangp nil llpllen nil llen nil dstchk1 nil dstchk2 nil chk nil)
440.   (prompt "\nUpper-left 2d polyline is highlighted - ENTER TO CONTINUE")
441.   (ssadd llpl ssss)
442.   (sssetfirst nil (ssadd llpl))
443.   (setq llpls nil)
444.   (gc)
445.   (command "\\")
446.  
447.   (command "_.ucs" "w")
448.   (prompt "\nAll corner 2d polylines are highlighted")
449.   (sssetfirst nil ssss)
450.  
451.   (princ)
452. )
453.  

M.R.

[pBe]

Posted an incomplete code at post #1..
I proceeded to follow the pseudo code on post # 2 just i could put together a working solution [not that its complete  ]

Like a person would normally solve a jigsaw puzzle, Start with corners. do the edge and the middle last.
I will try to shorten the code as soon as i done.

Lee. I finally got the chance to try your code, I'm still at awe how were you able to write the code with very few lines. [how did you manage that?]
I notice there are four pieces although connected to each other did not position itself correctly on the board. or is it just me.
Still dissecting your code as of this writing..... [and you call it terrible coding.    that would make  mine  as Horrible then

Marko.
I didn't realized or read your fist post thoroughly, but it appears that code only highlight the corner pieces but doesn't really placed it on the board
Based on the number of lines on your code I'm sure you have something up your sleeve and the code is just a tease

My code and LMs' code might work on your drawing attachment if there are no other straight [Vertical/Horizontal] lines inside your jigsaw board.
You know like an ordinary jigsaw puzzle you buy on wall-mart.

Cheers

[pBe]

I have an idea.... what about playing "pick up where i left off" kind game.
Any takers?

Note: THIS IS NOT A DESPERATE ATTEMPT TO COMPLETE MY CODE [Though it looks like it]    <seriously its not>

[ribarm]

My code is changed slightly to accept this case - note that edges intersect just in the center of rectangle and there are by 2 pieces with the same length of edge (crossing line is divided on half), so I had to add checking case with reversed order of selection set... One more (defun)... See attached example if you don't understand what I've explained...

Still - 4th corner can't be found - I just don't know why - everything is correctly written...

M.R.

[ribarm]

Also note that these cases aren't working at all with my code...

M.R. (see attached)