Author Topic: Automatic Nesting for lisp?  (Read 26893 times)

0 Members and 2 Guests are viewing this topic.

Marc'Antonio Alessi

  • Swamp Rat
  • Posts: 1451
  • Marco
Re: Automatic Nesting for lisp?
« Reply #15 on: November 12, 2016, 02:48:20 AM »
Reply to animated gif... Not 100% sure, but this is my simple version... Should work with imaginary rectangular bounding boxes like posted gif, but my version is using one single rectangle for entity where nesting is expected...
<>
Regards, M.R.
Tested on my sample, this is the result:

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Automatic Nesting for lisp?
« Reply #16 on: November 12, 2016, 04:12:48 AM »
Tested on my sample, this is the result:

Note that you must rotate all parts before "nesting.lsp" as it don't account for rotation - it just uses "move"... So if you have unsatisfied results this is the cause for that...
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

Marc'Antonio Alessi

  • Swamp Rat
  • Posts: 1451
  • Marco
Re: Automatic Nesting for lisp?
« Reply #17 on: November 12, 2016, 04:53:17 AM »
Tested on my sample, this is the result:

Note that you must rotate all parts before "nesting.lsp" as it don't account for rotation - it just uses "move"... So if you have unsatisfied results this is the cause for that...
The rotation is ok (I only draw a wrong cyan rectangle), this is the result:

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Automatic Nesting for lisp?
« Reply #18 on: November 12, 2016, 05:18:33 AM »
There is a rule in my algorithm that is : rectangles that have smallest height comes first to be nested and nesting is processed from that rectangle to the rectangle that have largest height (not width)... Nesting is processed in arrays of rows from bottom to top row... There is no rotations... So your example isn't quite adequate for this kind of nesting, and I don't quite know how to program it for your case, but if it makes you more happy, change height of main rectangle so that last 2 parts jump in... You will then see that there is larger gap on the right side from which you can shrink bounding rectangle... The result should be almost the same looking in wasted material areas...

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

:)

M.R. on Youtube

Marc'Antonio Alessi

  • Swamp Rat
  • Posts: 1451
  • Marco
Re: Automatic Nesting for lisp?
« Reply #19 on: November 12, 2016, 05:30:47 AM »
There is a rule in my algorithm that is : rectangles that have smallest height comes first to be nested and nesting is processed from that rectangle to the rectangle that have largest height (not width)... Nesting is processed in arrays of rows from bottom to top row... There is no rotations... So your example isn't quite adequate for this kind of nesting, and I don't quite know how to program it for your case, but if it makes you more happy, change height of main rectangle so that last 2 parts jump in... You will then see that there is larger gap on the right side from which you can shrink bounding rectangle... The result should be almost the same looking in wasted material areas...

HTH, M.R.
Thanks Marko it is a good start.  :-)    But why not start from rectangles with largest heigth?

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Automatic Nesting for lisp?
« Reply #20 on: November 12, 2016, 06:24:57 AM »
There is a rule in my algorithm that is : rectangles that have smallest height comes first to be nested and nesting is processed from that rectangle to the rectangle that have largest height (not width)... Nesting is processed in arrays of rows from bottom to top row... There is no rotations... So your example isn't quite adequate for this kind of nesting, and I don't quite know how to program it for your case, but if it makes you more happy, change height of main rectangle so that last 2 parts jump in... You will then see that there is larger gap on the right side from which you can shrink bounding rectangle... The result should be almost the same looking in wasted material areas...

HTH, M.R.
Thanks Marko it is a good start.  :-)    But why not start from rectangles with largest heigth?

If you try with various shapes of bounding boxes, you'll see that this is the most natural way... The smallest height on left from previous row is joined with little larger height - not the best, but that's the way the sorting is processed... So when next row comes the best way would be to join last from previous row with next row, but then nesting should be applied from right to left, and that means that no actual matching of left margin of bounding rectangle will be preserved while nesting... The way it's now operating is the most natural - with left margin, but as you can see in your example - often the routine is doing things making more waste of material than it should... Well, we have brains and we can make correct dispositions by intuition... It's just not possible to program that to computer in a few rows of codes... For me I am satisfied and how it works now - struggled a bit while finding correct alignment of next part with part from previous row, but I did it with using (vl-some) few times consecutively and I am pleased how results looked like in the end... Still for making it better I am afraid I need more experience and more brainstorming - predominantly theoretically... So the problem stays, but Lee offered some solution and I thought why not to do it straight away the fastest by coding this lisp...
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Automatic Nesting for lisp?
« Reply #21 on: November 12, 2016, 07:54:03 AM »
Here is my improved version, based on explained statement that the best is to array from left to right and then from right to left based on heights... Only what's more important I preserved left margin so algorithm is practically the same, only I changed arrays of sorting by groups (rows) so that it's now alternative...

Code - Auto/Visual Lisp: [Select]
  1. (defun c:nesting ( / *adoc* ss s bndr minp maxp w h i e eminp emaxp ew eh el eg egg k m x y yn bp ell elll )
  2.  
  3.  
  4.   (prompt "\nSelect nesting 2D entities...")
  5.   (setq ss (ssget "_:L"))
  6.   (prompt "\nPick boundary rectangle to nest to...")
  7.   (setq s (ssget "_+.:E:S" (list '(0 . "LWPOLYLINE") '(90 . 4) '(-4 . "<or") '(70 . 1) '(70 . 129) '(-4 . "or>") '(-4 . "<not") '(-4 . "<>") '(42 . 0.0) '(-4 . "not>"))))
  8.   (setq bndr (ssname s 0))
  9.   (vla-getboundingbox (vlax-ename->vla-object bndr) 'minp 'maxp)
  10.   (mapcar 'set '(minp maxp) (mapcar 'safearray-value (list minp maxp)))
  11.   (setq w (- (car maxp) (car minp)))
  12.   (setq h (- (cadr maxp) (cadr minp)))
  13.   (repeat (setq i (sslength ss))
  14.     (setq e (ssname ss (setq i (1- i))))
  15.     (vla-getboundingbox (vlax-ename->vla-object e) 'eminp 'emaxp)
  16.     (mapcar 'set '(eminp emaxp) (mapcar 'safearray-value (list eminp emaxp)))
  17.     (setq ew (- (car emaxp) (car eminp)))
  18.     (setq eh (- (cadr emaxp) (cadr eminp)))
  19.     (setq el (cons (list eminp ew eh e) el))
  20.   )
  21.   (setq el (vl-sort el '(lambda ( a b ) (if (equal (caddr a) (caddr b) 1e-3) (< (cadr a) (cadr b)) (< (caddr a) (caddr b))))))
  22.   (setq k 0.0 m 0)
  23.   (while (setq e (car el))
  24.     (setq k (+ k (cadr e)))
  25.     (if (< k w)
  26.       (setq eg (cons e eg))
  27.       (progn
  28.         (setq k 0.0 m (1+ m))
  29.         (if (= (rem m 2) 0)
  30.           (setq egg (cons eg egg))
  31.           (setq egg (cons (reverse eg) egg))
  32.         )
  33.         (setq eg nil k (+ k (cadr e)) eg (cons e eg))
  34.       )
  35.     )
  36.     (setq el (cdr el))
  37.   )
  38.   (if (not (vl-position (car eg) (apply 'append egg)))
  39.     (if (= (rem m 2) 1)
  40.       (setq egg (cons eg egg))
  41.       (setq egg (cons (reverse eg) egg))
  42.     )
  43.   )
  44.   (setq el (apply 'append (reverse egg)))
  45.   (while
  46.     (and
  47.       (car el)
  48.       (<
  49.         (cond
  50.           ( (null x) (setq x 0.0 y 0.0) x )
  51.           ( (> (+ x (cadar el)) w)
  52.             (setq x 0.0)
  53.             (foreach e elll
  54.               (setq ell (vl-remove e ell))
  55.             )
  56.             (setq elll ell)
  57.             (vl-some
  58.              '(lambda ( e )
  59.                 (if (< (cadar el) (car e))
  60.                   (setq y (+ (cadr e) (caddr (caddr e))))
  61.                 )
  62.               )
  63.               (reverse ell)
  64.             )
  65.             x
  66.           )
  67.           ( t
  68.             (if
  69.               (not
  70.                 (vl-some
  71.                  '(lambda ( e )
  72.                     (if (< (+ x (cadar el)) (car e))
  73.                       (setq yn (+ (cadr e) (caddr (caddr e))))
  74.                     )
  75.                   )
  76.                   (reverse ell)
  77.                 )
  78.               )
  79.               (vl-some
  80.                '(lambda ( e )
  81.                   (if (or (< (+ x (cadar el)) (car e)) (< (+ x 1e-3) (car e)))
  82.                     (setq yn (+ (cadr e) (caddr (caddr e))))
  83.                   )
  84.                 )
  85.                 (vl-sort ell '(lambda ( a b ) (> (car a) (car b))))
  86.               )
  87.             )
  88.             x
  89.           )
  90.         )
  91.         w
  92.       )
  93.       (if (> yn y)
  94.         (setq y yn)
  95.         y
  96.       )
  97.       (or (< (+ y (caddar el)) h) (equal (+ y (caddar el)) h 1e-3))
  98.     )
  99.     (if (= x 0.0)
  100.       (setq bp (list (car minp) (+ y (cadr minp)) 0.0))
  101.       (setq bp (list (+ x (car minp)) (+ y (cadr minp)) 0.0))
  102.     )
  103.     (setq x (+ x (cadar el)))
  104.     (vla-move (vlax-ename->vla-object (cadddr (car el))) (vlax-3d-point (caar el)) (vlax-3d-point bp))
  105.     (setq ell (cons (list x y (car el)) ell))
  106.     (setq el (cdr el))
  107.   )
  108.   (vla-endundomark *adoc*)
  109.   (princ)
  110. )
  111.  

HTH, M.R.

P.S. I don't think this will be useful for your example Marc', but generally it's much better...
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

well20152016

  • Newt
  • Posts: 130
Re: Automatic Nesting for lisp?
« Reply #22 on: November 13, 2016, 05:46:06 AM »
Thanks Marko ,My level is limited, I can only learn about your lisp.


1, the area or the X direction from large to small array.
2, according to the order of the different working surface, the height is not more than the height of the ladder. The last loop to find the most suitable small rectangle into the rectangle.
« Last Edit: November 15, 2016, 12:45:46 PM by well20152016 »

well20152016

  • Newt
  • Posts: 130
Re: Automatic Nesting for lisp?
« Reply #23 on: November 13, 2016, 11:34:51 AM »

Online to find some algorithms.

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Automatic Nesting for lisp?
« Reply #24 on: November 13, 2016, 02:53:10 PM »
Your pictures very much remind me on TETRIS, but I don't want to dive into rotation functionality... If someone else is willing he/she is welcomed to jump in, I am satisfied with my version by now...
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

Grrr1337

  • Swamp Rat
  • Posts: 812
Re: Automatic Nesting for lisp?
« Reply #25 on: November 13, 2016, 03:17:02 PM »
Your pictures very much remind me on TETRIS, but I don't want to dive into rotation functionality... If someone else is willing he/she is welcomed to jump in, I am satisfied with my version by now...
Why don't code something to play on TETRIS instead ?  :-D
(apply ''((a b c)(a b c))
  '(
    (( f L ) (apply 'strcat (f L)))
    (( L ) (if L (cons (chr (car L)) (f (cdr L)))))
    (72 101 108 108 111 32 87 111 114 108 100)
  )
)
vevo.bg

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Automatic Nesting for lisp?
« Reply #26 on: November 14, 2016, 05:50:47 AM »
I've noticed that on your example it works fine, but with random created rectangles it goes into endless loop...
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

well20152016

  • Newt
  • Posts: 130
Re: Automatic Nesting for lisp?
« Reply #27 on: November 14, 2016, 06:10:46 AM »
My level is limited, the code is more chaotic! Influence speed!

I Know,
Y the direction of the conversion when there is bug, need to be modified?
« Last Edit: November 14, 2016, 06:21:33 AM by well20152016 »

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Automatic Nesting for lisp?
« Reply #28 on: November 14, 2016, 07:47:29 AM »
The code is complex for me too... I've only formatted it better to be more readable and better for debugging... Only few my interventions - but generally it's the same code... Maybe you'll find it more operative in your quest for removing bug... Now only "code" tags...

Code: [Select]
(defun c:tt ( / get-rectangle-pts sort-XY count-ysame-ptr count-ysame-ptl *adoc* a aaa b base bbb1 bpts h i l0 lst lstt rts s ss sss sss1 w x y )

  (defun get-rectangle-pts ( en / pts )
    (setq pts
      (mapcar 'cdr
        (vl-remove-if-not
          (function
            (lambda ( x )
              (= (car x) 10)
            )
          ) (entget en)
        )
      )
    )
    (setq pts (sort-XY pts '(2 < <)) ) 
    (list (abs (- (caar pts) (caadr pts))) (abs (- (cadar pts) (cadr (cadddr pts)))) en pts)
  )

  (defun sort-XY ( lst fun / des des2 a )
    (defun des ( e1 e2 )
      ((eval (cadr fun)) (car e1) (car e2))
    )
    (defun des2 ( e1 e2 )
      ((eval (caddr fun)) (cadr e1) (cadr e2))
    )
    (cond
      ((= (car fun) 0) (vl-sort lst 'des))
      ((= (car fun) 1) (vl-sort lst 'des2))
      ((= (car fun) 2) (setq a (vl-sort lst 'des)) (vl-sort a 'des2))
      ((= (car fun) 3) (setq a (vl-sort lst 'des2)) (vl-sort a 'des))
    )
  )

  (defun count-ysame-ptr ( l / l1 l2 lst x )
    (while l
      (setq x (car l)
            l (cdr l)
           l1 (list x)
      )
      (foreach a l
        (if (equal (cadr x) (cadr a) 1e-3)
          (setq l1 (cons a l1))
          (setq l2 (cons a l2))
        )
      )
      (setq lst (cons l1 lst) l l2 l2 nil)
    )
    (setq lst
      (mapcar (function (lambda ( e )
        (car
          (vl-sort e (function (lambda ( e1 e2 )
            (> (car e1) (car e2))
          )))
        )
        )) lst
      )
    )
    (vl-sort lst (function (lambda ( e1 e2 ) (< (cadr e1) (cadr e2)))))
  )

  (defun count-ysame-ptl ( l bb / l1 l2 lst lst2 x )
    (while l
      (setq x (car l)
            l (cdr l)
           l1 (list x)
      )
      (foreach a l
        (if (equal (cadr x) (cadr a) 1e-3)
          (setq l1 (cons a l1))
          (setq l2 (cons a l2))
        )
      )
      (setq lst (cons l1 lst) l l2 l2 nil)
    )
    (setq lst
      (mapcar (function (lambda ( e )
        (car
          (vl-sort e (function (lambda ( e1 e2 )
            (< (car e1) (car e2))
          )))
        )
        )) lst
      )
    )
    (setq lst2 nil)
    (foreach a (vl-sort lst (function (lambda ( e1 e2 ) (> (cadr e1) (cadr e2)))))
      (if (> (cadr a) bb)
        (setq lst2 (cons a lst2))
      )
    )
    lst2
  )

  (vl-load-com)

  (vla-startundomark (setq *adoc* (vla-get-activedocument (vlax-get-acad-object))))
  (prompt "\nSelect nesting 2D entities...")
  (setq ss (ssget (list '(0 . "LWPOLYLINE") '(90 . 4) '(-4 . "<or") '(70 . 1) '(70 . 129) '(-4 . "or>") '(-4 . "<not") '(-4 . "<>") '(42 . 0.0) '(-4 . "not>"))))
  (prompt "\nPick boundary rectangle to nest to...")
  (setq s (ssget "_+.:E:S" (list '(0 . "LWPOLYLINE") '(90 . 4) '(-4 . "<or") '(70 . 1) '(70 . 129) '(-4 . "or>") '(-4 . "<not") '(-4 . "<>") '(42 . 0.0) '(-4 . "not>"))))
  (if ss (setq lst (mapcar (function (lambda ( x ) (get-rectangle-pts x))) (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))))
  (if s  (setq l0 (get-rectangle-pts (ssname s 0)) w (car l0) h (cadr l0) bpts (list (car (last l0)))))
  (setq lst (vl-sort lst (function (lambda ( a b ) (if (equal (cadr a) (cadr b) 1e-3) (> (car a) (car b)) (> (cadr a) (cadr b)))))))

  (setq i 0 lstt nil base (cadar (last l0)))
  (while lst
    (setq aaa
      (mapcar (function (lambda ( y )
        (mapcar (function (lambda ( x )
          (if (cdr bpts)
            (if
              (and
                (>= (- w (- (car y) (caar (last l0))) (car x)) 0)
                (>= (- (cadadr bpts) (cadr y) (cadr x)) 0)
              )
              x
            )
            (if
              (and
                (>= (- w (- (car y) (caar (last l0))) (car x)) 0)
                (>= (- h (cadr y) (cadr x)) 0)
              )
              x
            )
          ))) lst
        )
        )) bpts
      )
    )
    (if (apply 'or (apply 'append aaa))
      (progn
        (setq bbb1
          (car
            (setq sss1
              (vl-remove nil
                (setq sss
                  (mapcar (function (lambda ( x y )
                    (if (vl-remove nil x)
                      (list (vl-remove nil x) y)
                    )
                    )) aaa bpts
                  )
                )
              )
            )
          )
        )
        (setq aaa (caar bbb1))
        (vla-move (vlax-ename->vla-object (caddr aaa)) (vlax-3d-point (car (last aaa))) (vlax-3d-point (cadr bbb1)))
        (setq bpts
          (count-ysame-ptr
            (append
              (list (mapcar '+ (car bpts) (list (car aaa) 0)))
              bpts
            )
          )
        )
        (setq lstt (cons (caddr aaa) lstt))
        (setq lst
          (vl-remove-if (function (lambda ( b )
            (equal aaa b))) lst
          )
        )
        (setq base
          (cadar
            (last
              (get-rectangle-pts (caddr aaa))
            )
          )
        )
      ); then progn
      (progn
        (setq rts
          (count-ysame-ptl
            (apply 'append
              (mapcar 'last
                (mapcar (function (lambda ( x )
                  (get-rectangle-pts x))) lstt
                )
              )
            ) base
          )
        )
        (setq bpts
          (reverse
            (cons
              (list (caar (last l0)) (cadr (last rts)))
              (cdr (reverse rts))
            )
          )
        )
      ); else progn
    ); if
    (setq i (1+ i))
  ); while
  (vla-endundomark *adoc*)
  (princ)
)
« Last Edit: November 14, 2016, 10:28:01 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

Marc'Antonio Alessi

  • Swamp Rat
  • Posts: 1451
  • Marco
Re: Automatic Nesting for lisp?
« Reply #29 on: November 14, 2016, 12:52:12 PM »
Test on my simple DWG it goes into endless loop... (AutoCAD/Bricscad), see attached.