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

0 Members and 1 Guest are viewing this topic.

ribarm

  • Water Moccasin
  • Posts: 2369
  • Marko Ribar, architect
Re: ==={Challenge}=== Broken Pieces
« Reply #45 on: July 06, 2013, 11:26:15 AM »
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.
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

Lee Mac

  • Seagull
  • Posts: 12390
  • London, England
Re: ==={Challenge}=== Broken Pieces
« Reply #46 on: July 06, 2013, 12:51:31 PM »
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. )

fixo

  • Guest
Re: ==={Challenge}=== Broken Pieces
« Reply #47 on: July 06, 2013, 01:17:02 PM »

The above will put together the shapes.-
Thanks LE, it's working good through A2010-14
with small changes per release
Regards,

ribarm

  • Water Moccasin
  • Posts: 2369
  • Marko Ribar, architect
Re: ==={Challenge}=== Broken Pieces
« Reply #48 on: July 06, 2013, 05:02:45 PM »
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.
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

Lee Mac

  • Seagull
  • Posts: 12390
  • London, England
Re: ==={Challenge}=== Broken Pieces
« Reply #49 on: July 07, 2013, 06:39:05 AM »
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.
« Last Edit: July 07, 2013, 06:43:55 AM by Lee Mac »

ribarm

  • Water Moccasin
  • Posts: 2369
  • Marko Ribar, architect
Re: ==={Challenge}=== Broken Pieces
« Reply #50 on: July 07, 2013, 08:51:47 AM »
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?
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Water Moccasin
  • Posts: 2369
  • Marko Ribar, architect
Re: ==={Challenge}=== Broken Pieces
« Reply #51 on: July 07, 2013, 09:03:11 AM »
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...
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

LE3

  • Guest
Re: ==={Challenge}=== Broken Pieces
« Reply #52 on: July 07, 2013, 03:17:19 PM »
Thanks LE, it's working good through A2010-14
with small changes per release
Regards,
I am glad you tried - Thanks Oleg !