### Author Topic: ==={Challenge}=== Broken Pieces  (Read 8046 times)

0 Members and 1 Guest are viewing this topic.

#### pBe

• Bull Frog
• Posts: 377 ##### ==={Challenge}=== Broken Pieces
« on: June 15, 2013, 12:32:39 PM »
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]
`..............................`
« Last Edit: June 19, 2013, 01:30:54 AM by pBe »

#### pBe

• Bull Frog
• Posts: 377 ##### Re: ==={Challenge}=== Broken Pieces
« Reply #1 on: June 16, 2013, 03:53:14 AM »
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
« Last Edit: June 16, 2013, 04:09:58 AM by pBe » ##### Re: ==={Challenge}=== Broken Pieces
« Reply #2 on: June 16, 2013, 11:08:10 AM »
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

• Bull Frog
• Posts: 377 ##### Re: ==={Challenge}=== Broken Pieces
« Reply #3 on: June 16, 2013, 12:12:05 PM »
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  ##### Re: ==={Challenge}=== Broken Pieces
« Reply #4 on: June 16, 2013, 12:36:52 PM »
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.
« Last Edit: June 16, 2013, 12:42:14 PM by Lee Mac »

#### pBe

• Bull Frog
• Posts: 377 ##### Re: ==={Challenge}=== Broken Pieces
« Reply #5 on: June 16, 2013, 12:53:22 PM »
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 ##### Re: ==={Challenge}=== Broken Pieces
« Reply #6 on: June 16, 2013, 01:20:06 PM »
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))` « Last Edit: June 20, 2013, 05:57:23 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture) #### ribarm ##### Re: ==={Challenge}=== Broken Pieces
« Reply #7 on: June 17, 2013, 03:55:55 AM »
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.
Marko Ribar, d.i.a. (graduated engineer of architecture) #### ribarm ##### Re: ==={Challenge}=== Broken Pieces
« Reply #8 on: June 17, 2013, 07:05:00 AM »
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. Marko Ribar, d.i.a. (graduated engineer of architecture) #### pBe

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

M.R.
« Last Edit: June 20, 2013, 05:58:08 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture) #### pBe

• Bull Frog
• Posts: 377 ##### Re: ==={Challenge}=== Broken Pieces
« Reply #11 on: June 18, 2013, 01:49:45 AM »
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
« Last Edit: June 18, 2013, 01:56:23 AM by pBe »

#### pBe

• Bull Frog
• Posts: 377 ##### Re: ==={Challenge}=== Broken Pieces
« Reply #12 on: June 18, 2013, 02:03:42 AM »
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 ##### Re: ==={Challenge}=== Broken Pieces
« Reply #13 on: June 18, 2013, 04:57:36 AM »
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.
Marko Ribar, d.i.a. (graduated engineer of architecture) #### ribarm ##### Re: ==={Challenge}=== Broken Pieces
« Reply #14 on: June 18, 2013, 05:28:28 AM »
Also note that these cases aren't working at all with my code...

M.R. (see attached)
Marko Ribar, d.i.a. (graduated engineer of architecture) 