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

0 Members and 1 Guest are viewing this topic.

LULU1965

  • Mosquito
  • Posts: 16
Re: Automatic Nesting for lisp?
« Reply #30 on: November 15, 2016, 12:34:47 AM »
I introduce myself my name is Luciano and 30 years working on Autocad 2d and 3d.
I have a problem that now haunts for years and only you "GURU" of the Lisp language you can perhaps bring myself giving me a great HAND.Vi thank you in advance. Best Regards M.L.
« Last Edit: November 15, 2016, 07:14:40 AM by LULU1965 »

LULU1965

  • Mosquito
  • Posts: 16
Re: Automatic Nesting for lisp?
« Reply #31 on: November 15, 2016, 12:49:38 AM »
TOO BIG EXCUSE ME!!!! (PURGE)

Marc'Antonio Alessi

  • Swamp Rat
  • Posts: 1207
  • Marco
Re: Automatic Nesting for lisp?
« Reply #32 on: November 15, 2016, 02:23:37 AM »
TOO BIG EXCUSE ME!!!! (PURGE)
Luciano, puoi editare il tuo messaggio precedente e togliere l'allegato (mi pare che si possa fare) cosė non appesantisce il server. Ciao.

ribarm

  • Gator
  • Posts: 2525
  • Marko Ribar, architect
Re: Automatic Nesting for lisp?
« Reply #33 on: November 15, 2016, 06:33:48 AM »
Luciano, your DWG is showing the task human should do manually... No algorithm for this...

Marc'Antonio, I've managed to improve a little my version - added rotation functionality and changed a little sorting method... I'll attach DWG so that you can confirm slightly change in size of original master plate - should fit all pieces and waste of material is unavoidable - so this is as far as it can go for now by computation of lisp...

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.     (if (> ew eh)
  20.       (progn
  21.         (vla-rotate (vlax-ename->vla-object e) (vlax-3d-point (mapcar '/ (mapcar '+ eminp emaxp) (list 2.0 2.0 2.0))) (* 0.5 pi))
  22.         (vla-getboundingbox (vlax-ename->vla-object e) 'eminp 'emaxp)
  23.         (mapcar 'set '(eminp emaxp) (mapcar 'safearray-value (list eminp emaxp)))
  24.         (setq ew (- (car emaxp) (car eminp)))
  25.         (setq eh (- (cadr emaxp) (cadr eminp)))
  26.       )
  27.     )
  28.     (setq el (cons (list eminp ew eh e) el))
  29.   )
  30.   (setq el (vl-sort el '(lambda ( a b ) (if (equal (caddr a) (caddr b) 1e-3) (< (cadr a) (cadr b)) (< (caddr a) (caddr b))))))
  31.   ;|
  32.   (setq k 0.0 m 0)
  33.   (while (setq e (car el))
  34.     (setq k (+ k (cadr e)))
  35.     (if (< k w)
  36.       (setq eg (cons e eg))
  37.       (progn
  38.         (setq k 0.0 m (1+ m))
  39.         (if (= (rem m 2) 0)
  40.           (setq egg (cons eg egg))
  41.           (setq egg (cons (reverse eg) egg))
  42.         )
  43.         (setq eg nil k (+ k (cadr e)) eg (cons e eg))
  44.       )
  45.     )
  46.     (setq el (cdr el))
  47.   )
  48.   (if (not (vl-position (car eg) (apply 'append egg)))
  49.     (if (= (rem m 2) 1)
  50.       (setq egg (cons eg egg))
  51.       (setq egg (cons (reverse eg) egg))
  52.     )
  53.   )
  54.   (setq el (apply 'append (reverse egg)))
  55.   |;
  56.   (while
  57.     (and
  58.       (car el)
  59.       (<
  60.         (cond
  61.           ( (null x) (setq x 0.0 y 0.0) x )
  62.           ( (> (+ x (cadar el)) w)
  63.             (setq x 0.0)
  64.             (foreach e elll
  65.               (setq ell (vl-remove e ell))
  66.             )
  67.             (setq elll ell)
  68.             (setq y (+ (cadr (car (reverse ell))) (caddr (caddr (car (reverse ell))))))
  69.             (vl-some
  70.              '(lambda ( e )
  71.                 (if (< (cadar el) (+ (car e) 1e-3))
  72.                   (setq yn (+ (cadr e) (caddr (caddr e))))
  73.                 )
  74.               )
  75.               (reverse ell)
  76.             )
  77.             (if (> yn y)
  78.               (setq y yn)
  79.             )
  80.             x
  81.           )
  82.           ( t
  83.             (if
  84.               (not
  85.                 (vl-some
  86.                  '(lambda ( e )
  87.                     (if (< (+ x (cadar el)) (+ (car e) 1e-3))
  88.                       (setq yn (+ (cadr e) (caddr (caddr e))))
  89.                     )
  90.                   )
  91.                   (reverse ell)
  92.                 )
  93.               )
  94.               (vl-some
  95.                '(lambda ( e )
  96.                   (if (or (< (+ x (cadar el)) (car e)) (< (+ x 1e-3) (car e)))
  97.                     (setq yn (+ (cadr e) (caddr (caddr e))))
  98.                   )
  99.                 )
  100.                 (vl-sort ell '(lambda ( a b ) (> (car a) (car b))))
  101.               )
  102.             )
  103.             (if (> yn y)
  104.               (setq y yn)
  105.             )
  106.             x
  107.           )
  108.         )
  109.         w
  110.       )
  111.       (or (< (+ y (caddar el)) h) (equal (+ y (caddar el)) h 1e-3))
  112.     )
  113.     (if (= x 0.0)
  114.       (setq bp (list (car minp) (+ y (cadr minp)) 0.0))
  115.       (setq bp (list (+ x (car minp)) (+ y (cadr minp)) 0.0))
  116.     )
  117.     (setq x (+ x (cadar el)))
  118.     (vla-move (vlax-ename->vla-object (cadddr (car el))) (vlax-3d-point (caar el)) (vlax-3d-point bp))
  119.     (setq ell (cons (list x y (car el)) ell))
  120.     (setq el (cdr el))
  121.   )
  122.   (vla-endundomark *adoc*)
  123.   (princ)
  124. )
  125.  

Regards, M.R.
« Last Edit: November 16, 2016, 12:44:53 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

m4rdy

  • Newt
  • Posts: 62
Re: Automatic Nesting for lisp?
« Reply #34 on: November 15, 2016, 07:05:44 AM »
This is good start too for learn if anybody know delphi/pascal (Unfortunately, I don't).
http://delphiforfun.org/Programs/CutList.htm
http://delphiforfun.org/Programs/tilefit.htm
Autocad 2007, Windows XP

ribarm

  • Gator
  • Posts: 2525
  • Marko Ribar, architect
Re: Automatic Nesting for lisp?
« Reply #35 on: November 15, 2016, 08:39:52 AM »
Changed part of code - last intervention till now :

Code: [Select]
      ...
      (<
        (cond
          ( (null x) (setq x 0.0 y 0.0) x )
          ( (> (+ x (cadar el)) w)
            (setq x 0.0)
            (foreach e elll
              (setq ell (vl-remove e ell))
            )
            (setq elll ell)
            (setq y (+ (cadr (car (reverse ell))) (caddr (caddr (car (reverse ell))))))
            (vl-some
             '(lambda ( e )
                (if (< (cadar el) (+ (car e) 1e-3))
                  (setq yn (+ (cadr e) (caddr (caddr e))))
                )
              )
              (reverse ell)
            )
            (if (> yn y)
              (setq y yn)
            )
            x
          )
          ( t
            (if
              (not
                (vl-some
                 '(lambda ( e )
                    (if (< (+ x (cadar el)) (+ (car e) 1e-3))
                      (setq yn (+ (cadr e) (caddr (caddr e))))
                    )
                  )
                  (reverse ell)
                )
              )
              (vl-some
               '(lambda ( e )
                  (if (or (< (+ x (cadar el)) (car e)) (< (+ x 1e-3) (car e)))
                    (setq yn (+ (cadr e) (caddr (caddr e))))
                  )
                )
                (vl-sort ell '(lambda ( a b ) (> (car a) (car b))))
              )
            )
            (if (> yn y)
              (setq y yn)
            )
            x
          )
        )
        w
      )
      ...
« Last Edit: November 16, 2016, 12:45:46 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

well20152016

  • Newt
  • Posts: 88
Re: Automatic Nesting for lisp?
« Reply #36 on: November 15, 2016, 08:41:08 AM »
thank!Marko !
I have no time today, another day!

ribarm

  • Gator
  • Posts: 2525
  • Marko Ribar, architect
Re: Automatic Nesting for lisp?
« Reply #37 on: November 15, 2016, 08:53:50 AM »
Ooops, I've changed my revision...
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

Marc'Antonio Alessi

  • Swamp Rat
  • Posts: 1207
  • Marco
Re: Automatic Nesting for lisp?
« Reply #38 on: November 15, 2016, 09:54:09 AM »
Ooops, I've changed my revision...
This is the result, but in my sample I do not need to rotate the rectangles, they are in the rigth rotation, grazie ancora.

ribarm

  • Gator
  • Posts: 2525
  • Marko Ribar, architect
Re: Automatic Nesting for lisp?
« Reply #39 on: November 15, 2016, 10:30:11 AM »
After more researching, I've found that alternative disposition of rectangles from left to right and then in next row from right to left has some lacks - while grouping in revising order groups are different than afterward row calculation as groups are alternatively reversed and therefore dimension in afterward row calculation may jump in from different group (next one) - this causes that method can't be reliable and therefore I've returned my code in previous state - sorting and disposition is going only from left to right by rows and height of boxes are growing constantly... My code revised now - look in my last posted colored code tag...
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 2525
  • Marko Ribar, architect
Re: Automatic Nesting for lisp?
« Reply #40 on: November 15, 2016, 10:34:31 AM »
This is what my nesting is doing... Red rectangle is modified one, and green one is yours Marc'Antonio...
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

Marc'Antonio Alessi

  • Swamp Rat
  • Posts: 1207
  • Marco
Re: Automatic Nesting for lisp?
« Reply #41 on: November 15, 2016, 12:20:43 PM »
This is what my nesting is doing... Red rectangle is modified one, and green one is yours Marc'Antonio...
Ok, thanks I will try to see if I can understand how it works.    :-)

well20152016

  • Newt
  • Posts: 88
Re: Automatic Nesting for lisp?
« Reply #42 on: November 15, 2016, 08:52:48 PM »
Ooops, I've changed my revision...


Why don't you try it out from the big to the small

ribarm

  • Gator
  • Posts: 2525
  • Marko Ribar, architect
Re: Automatic Nesting for lisp?
« Reply #43 on: November 16, 2016, 12:36:59 AM »
Ooops, I've changed my revision...


Why don't you try it out from the big to the small

I'll leave that intervention to the user that has followed discussion... It's only one sign problematic...
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

LULU1965

  • Mosquito
  • Posts: 16
Re: Automatic Nesting for lisp?
« Reply #44 on: November 16, 2016, 10:52:51 AM »
E' POSSIBILE FARE QUESTO LISP CON LA POSSIBILITA DI SELEZIONARE UN MAGGIOR NUMERO DI "Pick boundary rectangle to nest to..." MULTIPLI
QUELLO SENZA ROTAZIONE DELLE PARTI PIU' PICCOLE CHE VENGONO INNESTATE.

(defun c:tt ( / *adoc* a aaa b base bbb1 bpts h i l0 lst lstt rts s ss sss sss1 w x y)

SCUSATEMI PER IL DISTURBO "GRAZIE
----------------------------------------------------------------------------------------------------------------------------------------------------------------
IS POSSIBLE TO MAKE THIS LISP WITH THE OPPORTUNITY TO SELECT A HIGHER NUMBER OF "Pick boundary rectangle to nest to ..." MULTIPLE
IS WITHOUT ROTATING PARTS MORE 'SMALL THAT ARE GRAFTED.

(Defun c: tt (/ * * adoc a aaa b basis bbb1 bp h i l0 lst LSTT rts s ss sss SSS1 w x y)

Sorry for DISORDER "THANK YOU" THANKS