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

0 Members and 1 Guest are viewing this topic.

ribarm

  • Gator
  • Posts: 2519
  • Marko Ribar, architect
Re: Automatic Nesting for lisp?
« Reply #60 on: June 11, 2021, 11:29:46 AM »
Quote
I've added error handler, calculation of UNDO steps after finish and changed order of generating "l" list of (bp dx dy) so that when first pass of (main) function finishes it checks from lower left corner of main boundary for "bp"s again and not as it was from upper right to lower left... That's one thing in main routine "nesting.lsp" and I tried to make additional "nesting-new.lsp" with (process2rec) function that would try to implement checking of relation of 2 rectangles in processing nesting - all I could think of is that with this checking it's sometimes different choice of processing order of entities from list "el"... Marc's example with bigger main boundary is solvable by "nesting-new.lsp" and first DWG is somewhat better with original "nesting.lsp"... If someone has something new based on "nesting.lsp" it would be good to try to improve it, or post an opinion of what could be better and (or) relevant to this topic... Thanks for attention...

Here is "nesting-new.lsp" (look on previous page for "nesting.lsp")
http://www.theswamp.org/index.php?topic=52260.msg605093#msg605093


Code - Auto/Visual Lisp: [Select]
  1. (defun c:nesting-new ( / *error* car-sort insiderec process2rec process main adoc cmde ss s i e minpt maxpt dx dy el lw bp l ll al ka kb f )
  2.  
  3.  
  4.   (defun *error* ( m )
  5.     (if cmde
  6.       (setvar 'cmdecho cmde)
  7.     )
  8.     (if adoc
  9.       (vla-endundomark adoc)
  10.     )
  11.     (if m
  12.       (prompt m)
  13.     )
  14.     (princ)
  15.   )
  16.  
  17.   (defun car-sort ( lst cmp / rtn )
  18.     (setq rtn (car lst))
  19.     (foreach itm (cdr lst)
  20.       (if (apply cmp (list itm rtn))
  21.         (setq rtn itm)
  22.       )
  23.     )
  24.     rtn
  25.   )
  26.  
  27.   (defun insiderec ( ll ur p )
  28.     (and
  29.       (< (car ll) (car p) (car ur))
  30.       (< (cadr ll) (cadr p) (cadr ur))
  31.     )
  32.   )
  33.  
  34.   (defun process2rec ( e el / dx1 dy1 dx2 dy2 ddxy1 ddxy2 ddxy3 ddxy4 ddxy5 ddxy6 ddxy7 ddxy8 a1 a2 a3 a4 a5 a6 a7 a8 r )
  35.     (if (and e (> (length el) 1))
  36.       (progn
  37.         (setq dx1 (caadr e))
  38.         (setq dy1 (cadadr e))
  39.         (foreach ee (vl-remove e el)
  40.           (setq dx2 (caadr ee))
  41.           (setq dy2 (cadadr ee))
  42.           (setq ddxy1 (list (+ dx1 dx2) (max dy1 dy2))) ;;; right side e normal ee normal
  43.           (setq ddxy2 (list (+ dx1 dy2) (max dy1 dx2))) ;;; right side e normal ee rotated
  44.           (setq ddxy3 (list (+ dy1 dx2) (max dx1 dy2))) ;;; right side e rotated ee normal
  45.           (setq ddxy4 (list (+ dy1 dy2) (max dx1 dx2))) ;;; right side e rotated ee rotated
  46.           (setq ddxy5 (list (max dx1 dx2) (+ dy1 dy2))) ;;; up side e normal ee normal
  47.           (setq ddxy6 (list (max dx1 dy2) (+ dy1 dx2))) ;;; up side e normal ee rotated
  48.           (setq ddxy7 (list (max dy1 dx2) (+ dx1 dy2))) ;;; up side e rotated ee normal
  49.           (setq ddxy8 (list (max dy1 dy2) (+ dx1 dx2))) ;;; up side e rotated ee rotated
  50.           (mapcar 'set '(a1 a2 a3 a4 a5 a6 a7 a8) (mapcar '(lambda ( x ) (* (car x) (cadr x))) (list ddxy1 ddxy2 ddxy3 ddxy4 ddxy5 ddxy6 ddxy7 ddxy8)))
  51.           (setq r (cons (list (- a1 (* dx1 dy1) (* dx2 dy2)) (list e ee) ddxy1 "1") r))
  52.           (setq r (cons (list (- a2 (* dx1 dy1) (* dx2 dy2)) (list e ee) ddxy2 "2") r))
  53.           (setq r (cons (list (- a3 (* dx1 dy1) (* dx2 dy2)) (list e ee) ddxy3 "3") r))
  54.           (setq r (cons (list (- a4 (* dx1 dy1) (* dx2 dy2)) (list e ee) ddxy4 "4") r))
  55.           (setq r (cons (list (- a5 (* dx1 dy1) (* dx2 dy2)) (list e ee) ddxy5 "5") r))
  56.           (setq r (cons (list (- a6 (* dx1 dy1) (* dx2 dy2)) (list e ee) ddxy6 "6") r))
  57.           (setq r (cons (list (- a7 (* dx1 dy1) (* dx2 dy2)) (list e ee) ddxy7 "7") r))
  58.           (setq r (cons (list (- a8 (* dx1 dy1) (* dx2 dy2)) (list e ee) ddxy8 "8") r))
  59.         )
  60.         (car-sort r '(lambda ( a b ) (if (= (car a) (car b)) (< (* (car (caddr a)) (cadr (caddr a))) (* (car (caddr b)) (cadr (caddr b)))) (< (car a) (car b)))))
  61.       )
  62.     )
  63.   )
  64.  
  65.   (defun process ( el bp dx dy / e1 e2 dd1 dd2 e r )
  66.     (if (= 8 (logand 8 (getvar 'undoctl)))
  67.       (vla-endundomark adoc)
  68.     )
  69.     (vla-startundomark adoc)
  70.     (setq ka (1+ ka))
  71.     (setq kb (1+ kb))
  72.     (setq f nil)
  73.     (if (> (length el) 1)
  74.       (progn
  75.         (foreach e el
  76.           (setq r (cons (process2rec e el) r))
  77.         )
  78.         (setq r (car-sort
  79.                   (vl-remove-if '(lambda ( x )
  80.                                    (or
  81.                                      (minusp (- dx (car (caddr x))))
  82.                                      (minusp (- dy (cadr (caddr x))))
  83.                                    )
  84.                                  ) r
  85.                   ) '(lambda ( a b ) (< (min (- dx (car (caddr a))) (- dy (cadr (caddr a)))) (min (- dx (car (caddr b))) (- dy (cadr (caddr b))))))))
  86.       )
  87.     )
  88.     (if r
  89.       (if (or (= (last r) "1") (= (last r) "2") (= (last r) "5") (= (last r) "6"))
  90.         (progn
  91.           (setq e (caadr r))
  92.           (if
  93.             (not
  94.               (and
  95.                 (not (vl-some '(lambda ( x ) (insiderec (car x) (cadr x) (mapcar '+ bp (list 1e-3 1e-3)))) al))
  96.                 (not (vl-some '(lambda ( x ) (insiderec (car x) (cadr x) (mapcar '+ bp (list (caadr e) 0.0) (list -1e-3 1e-3)))) al))
  97.                 (not (vl-some '(lambda ( x ) (insiderec (car x) (cadr x) (mapcar '+ bp (list 0.0 (cadadr e)) (list 1e-3 -1e-3)))) al))
  98.                 (not (vl-some '(lambda ( x ) (insiderec (car x) (cadr x) (mapcar '+ bp (list (caadr e) (cadadr e)) (list -1e-3 -1e-3)))) al))
  99.                 (not (vl-some '(lambda ( x ) (insiderec (car x) (cadr x) (mapcar '+ bp (list (* (caadr e) 0.5) (* (cadadr e) 0.5))))) al))
  100.                 (not (vl-some '(lambda ( x ) (insiderec bp (mapcar '+ bp (list (caadr e) (cadadr e))) (car x))) al))
  101.                 (not (vl-some '(lambda ( x ) (insiderec bp (mapcar '+ bp (list (caadr e) (cadadr e))) (mapcar '+ (car x) (list (- (caadr x) (caar x)) 0.0)))) al))
  102.                 (not (vl-some '(lambda ( x ) (insiderec bp (mapcar '+ bp (list (caadr e) (cadadr e))) (cadr x))) al))
  103.                 (not (vl-some '(lambda ( x ) (insiderec bp (mapcar '+ bp (list (caadr e) (cadadr e))) (mapcar '+ (car x) (list 0.0 (- (cadadr x) (cadar x)))))) al))
  104.                 (not (vl-some '(lambda ( x ) (insiderec bp (mapcar '+ bp (list (caadr e) (cadadr e))) (mapcar '+ (car x) (list (* (- (caadr x) (caar x)) 0.5) (* (- (cadadr x) (cadar x)) 0.5))))) al))
  105.               )
  106.             )
  107.             (setq e nil)
  108.           )
  109.         )
  110.         (progn
  111.           (setq e (caadr r))
  112.           (if
  113.             (not
  114.               (and
  115.                 (not (vl-some '(lambda ( x ) (insiderec (car x) (cadr x) (mapcar '+ bp (list 1e-3 1e-3)))) al))
  116.                 (not (vl-some '(lambda ( x ) (insiderec (car x) (cadr x) (mapcar '+ bp (list (cadadr e) 0.0) (list -1e-3 1e-3)))) al))
  117.                 (not (vl-some '(lambda ( x ) (insiderec (car x) (cadr x) (mapcar '+ bp (list 0.0 (caadr e)) (list 1e-3 -1e-3)))) al))
  118.                 (not (vl-some '(lambda ( x ) (insiderec (car x) (cadr x) (mapcar '+ bp (list (cadadr e) (caadr e)) (list -1e-3 -1e-3)))) al))
  119.                 (not (vl-some '(lambda ( x ) (insiderec (car x) (cadr x) (mapcar '+ bp (list (* (cadadr e) 0.5) (* (caadr e) 0.5))))) al))
  120.                 (not (vl-some '(lambda ( x ) (insiderec bp (mapcar '+ bp (list (cadadr e) (caadr e))) (car x))) al))
  121.                 (not (vl-some '(lambda ( x ) (insiderec bp (mapcar '+ bp (list (cadadr e) (caadr e))) (mapcar '+ (car x) (list (- (caadr x) (caar x)) 0.0)))) al))
  122.                 (not (vl-some '(lambda ( x ) (insiderec bp (mapcar '+ bp (list (cadadr e) (caadr e))) (cadr x))) al))
  123.                 (not (vl-some '(lambda ( x ) (insiderec bp (mapcar '+ bp (list (cadadr e) (caadr e))) (mapcar '+ (car x) (list 0.0 (- (cadadr x) (cadar x)))))) al))
  124.                 (not (vl-some '(lambda ( x ) (insiderec bp (mapcar '+ bp (list (cadadr e) (caadr e))) (mapcar '+ (car x) (list (* (- (caadr x) (caar x)) 0.5) (* (- (cadadr x) (cadar x)) 0.5))))) al))
  125.               )
  126.             )
  127.             (setq e nil)
  128.           )
  129.           (if e
  130.             (setq f t)
  131.           )
  132.         )
  133.       )
  134.     )
  135.     (if (null e)
  136.       (progn
  137.         (setq e1 (car-sort
  138.                    (vl-remove-if '(lambda ( x )
  139.                                     (or
  140.                                       (vl-some '(lambda ( y ) (insiderec (car y) (cadr y) (mapcar '+ bp (list 1e-3 1e-3)))) al)
  141.                                       (vl-some '(lambda ( y ) (insiderec (car y) (cadr y) (mapcar '+ bp (list (caadr x) 0.0) (list -1e-3 1e-3)))) al)
  142.                                       (vl-some '(lambda ( y ) (insiderec (car y) (cadr y) (mapcar '+ bp (list 0.0 (cadadr x)) (list 1e-3 -1e-3)))) al)
  143.                                       (vl-some '(lambda ( y ) (insiderec (car y) (cadr y) (mapcar '+ bp (list (caadr x) (cadadr x)) (list -1e-3 -1e-3)))) al)
  144.                                       (vl-some '(lambda ( y ) (insiderec (car y) (cadr y) (mapcar '+ bp (list (* (caadr x) 0.5) (* (cadadr x) 0.5))))) al)
  145.                                       (vl-some '(lambda ( y ) (insiderec bp (mapcar '+ bp (list (caadr x) (cadadr x))) (car y))) al)
  146.                                       (vl-some '(lambda ( y ) (insiderec bp (mapcar '+ bp (list (caadr x) (cadadr x))) (mapcar '+ (car y) (list (- (caadr y) (caar y)) 0.0)))) al)
  147.                                       (vl-some '(lambda ( y ) (insiderec bp (mapcar '+ bp (list (caadr x) (cadadr x))) (cadr y))) al)
  148.                                       (vl-some '(lambda ( y ) (insiderec bp (mapcar '+ bp (list (caadr x) (cadadr x))) (mapcar '+ (car y) (list 0.0 (- (cadadr y) (cadar y)))))) al)
  149.                                       (vl-some '(lambda ( y ) (insiderec bp (mapcar '+ bp (list (caadr x) (cadadr x))) (mapcar '+ (car y) (list (* (- (caadr y) (caar y)) 0.5) (* (- (cadadr y) (cadar y)) 0.5))))) al)
  150.                                       (minusp (- dx (caadr x)))
  151.                                       (minusp (- dy (cadadr x)))
  152.                                     )
  153.                                   ) el
  154.                    ) '(lambda ( a b ) (< (min (- dx (caadr a)) (- dy (cadadr a))) (min (- dx (caadr b)) (- dy (cadadr b)))))))
  155.         (setq e2 (car-sort
  156.                    (vl-remove-if '(lambda ( x )
  157.                                     (or
  158.                                       (vl-some '(lambda ( y ) (insiderec (car y) (cadr y) (mapcar '+ bp (list 1e-3 1e-3)))) al)
  159.                                       (vl-some '(lambda ( y ) (insiderec (car y) (cadr y) (mapcar '+ bp (list (cadadr x) 0.0) (list -1e-3 1e-3)))) al)
  160.                                       (vl-some '(lambda ( y ) (insiderec (car y) (cadr y) (mapcar '+ bp (list 0.0 (caadr x)) (list 1e-3 -1e-3)))) al)
  161.                                       (vl-some '(lambda ( y ) (insiderec (car y) (cadr y) (mapcar '+ bp (list (cadadr x) (caadr x)) (list -1e-3 -1e-3)))) al)
  162.                                       (vl-some '(lambda ( y ) (insiderec (car y) (cadr y) (mapcar '+ bp (list (* (cadadr x) 0.5) (* (caadr x) 0.5))))) al)
  163.                                       (vl-some '(lambda ( y ) (insiderec bp (mapcar '+ bp (list (cadadr x) (caadr x))) (car y))) al)
  164.                                       (vl-some '(lambda ( y ) (insiderec bp (mapcar '+ bp (list (cadadr x) (caadr x))) (mapcar '+ (car y) (list (- (caadr y) (caar y)) 0.0)))) al)
  165.                                       (vl-some '(lambda ( y ) (insiderec bp (mapcar '+ bp (list (cadadr x) (caadr x))) (cadr y))) al)
  166.                                       (vl-some '(lambda ( y ) (insiderec bp (mapcar '+ bp (list (cadadr x) (caadr x))) (mapcar '+ (car y) (list 0.0 (- (cadadr y) (cadar y)))))) al)
  167.                                       (vl-some '(lambda ( y ) (insiderec bp (mapcar '+ bp (list (cadadr x) (caadr x))) (mapcar '+ (car y) (list (* (- (caadr y) (caar y)) 0.5) (* (- (cadadr y) (cadar y)) 0.5))))) al)
  168.                                       (minusp (- dx (cadadr x)))
  169.                                       (minusp (- dy (caadr x)))
  170.                                     )
  171.                                   ) el
  172.                    ) '(lambda ( a b ) (< (min (- dx (cadadr a)) (- dy (caadr a))) (min (- dx (cadadr b)) (- dy (caadr b)))))))
  173.         (cond
  174.           ( (and e1 e2)
  175.             (setq dd1 (min (- dx (caadr e1)) (- dy (cadadr e1))))
  176.             (setq dd2 (min (- dx (cadadr e2)) (- dy (caadr e2))))
  177.             (if (< dd1 dd2)
  178.               (setq e e1)
  179.               (progn
  180.                 (vla-rotate (vlax-ename->vla-object (car e2)) (vlax-3d-point (caddr e2)) (* 0.5 pi))
  181.                 (vla-move (vlax-ename->vla-object (car e2)) (vlax-3d-point '(0 0)) (vlax-3d-point (mapcar '+ '(0 0) (list (cadadr e2) 0.0))))
  182.                 (setq e (subst (list (cadadr e2) (caadr e2)) (cadr e2) e2))
  183.               )
  184.             )
  185.           )
  186.           ( (and e1 (null e2))
  187.             (setq e e1)
  188.           )
  189.           ( (and e2 (null e1))
  190.             (vla-rotate (vlax-ename->vla-object (car e2)) (vlax-3d-point (caddr e2)) (* 0.5 pi))
  191.             (vla-move (vlax-ename->vla-object (car e2)) (vlax-3d-point '(0 0)) (vlax-3d-point (mapcar '+ '(0 0) (list (cadadr e2) 0.0))))
  192.             (setq e (subst (list (cadadr e2) (caadr e2)) (cadr e2) e2))
  193.           )
  194.         )
  195.       )
  196.     )
  197.     e
  198.   )
  199.  
  200.   (defun main ( el bp dx dy )
  201.     (if (setq e (process el bp dx dy))
  202.       (progn
  203.         (if f
  204.           (progn
  205.             (vla-rotate (vlax-ename->vla-object (car e)) (vlax-3d-point (caddr e)) (* 0.5 pi))
  206.             (vla-move (vlax-ename->vla-object (car e)) (vlax-3d-point '(0 0)) (vlax-3d-point (mapcar '+ '(0 0) (list (cadadr e) 0.0))))
  207.             (setq e (subst (list (cadadr e) (caadr e)) (cadr e) e))
  208.           )
  209.         )
  210.         (setq al (cons (list bp (mapcar '+ bp (list (caadr e) (cadadr e)))) al))
  211.         (setq l (append l (list (list (mapcar '+ bp (list (caadr e) 0.0)) (- dx (caadr e)) dy))))
  212.         (setq l (append l (list (list (mapcar '+ bp (list 0.0 (cadadr e))) dx (- dy (cadadr e))))))
  213.         (setq l (append l (list (list (mapcar '+ bp (list (caadr e) (cadadr e))) (- dx (caadr e)) (- dy (cadadr e))))))
  214.         (setq l (vl-remove-if '(lambda ( x ) (vl-some '(lambda ( y ) (equal (car x) y 1e-6)) (mapcar 'car al))) l))
  215.         (if
  216.           (and
  217.             (not (vl-some '(lambda ( x ) (insiderec (car x) (cadr x) (mapcar '+ bp (list 1e-3 1e-3)))) (cdr al)))
  218.             (not (vl-some '(lambda ( x ) (insiderec (car x) (cadr x) (mapcar '+ bp (list (caadr e) 0.0) (list -1e-3 1e-3)))) (cdr al)))
  219.             (not (vl-some '(lambda ( x ) (insiderec (car x) (cadr x) (mapcar '+ bp (list 0.0 (cadadr e)) (list 1e-3 -1e-3)))) (cdr al)))
  220.             (not (vl-some '(lambda ( x ) (insiderec (car x) (cadr x) (mapcar '+ bp (list (caadr e) (cadadr e)) (list -1e-3 -1e-3)))) (cdr al)))
  221.             (not (vl-some '(lambda ( x ) (insiderec (car x) (cadr x) (mapcar '+ bp (list (* (caadr e) 0.5) (* (cadadr e) 0.5))))) (cdr al)))
  222.             (not (vl-some '(lambda ( x ) (insiderec bp (mapcar '+ bp (list (caadr e) (cadadr e))) (car x))) (cdr al)))
  223.             (not (vl-some '(lambda ( x ) (insiderec bp (mapcar '+ bp (list (caadr e) (cadadr e))) (mapcar '+ (car x) (list (- (caadr x) (caar x)) 0.0)))) (cdr al)))
  224.             (not (vl-some '(lambda ( x ) (insiderec bp (mapcar '+ bp (list (caadr e) (cadadr e))) (cadr x))) (cdr al)))
  225.             (not (vl-some '(lambda ( x ) (insiderec bp (mapcar '+ bp (list (caadr e) (cadadr e))) (mapcar '+ (car x) (list 0.0 (- (cadadr x) (cadar x)))))) (cdr al)))
  226.             (not (vl-some '(lambda ( x ) (insiderec bp (mapcar '+ bp (list (caadr e) (cadadr e))) (mapcar '+ (car x) (list (* (- (caadr x) (caar x)) 0.5) (* (- (cadadr x) (cadar x)) 0.5))))) (cdr al)))
  227.           )
  228.           (progn
  229.             (vla-move (vlax-ename->vla-object (car e)) (vlax-3d-point (caddr e)) (vlax-3d-point bp))
  230.             (setq el (vl-remove-if '(lambda ( x ) (eq (car x) (car e))) el))
  231.             (cond
  232.               ( (process el (mapcar '+ bp (list (caadr e) 0.0)) (- dx (caadr e)) dy)
  233.                 (vl-cmdf "_.undo" "_b")
  234.                 (setq kb (1- kb))
  235.                 (main el (mapcar '+ bp (list (caadr e) 0.0)) (- dx (caadr e)) dy)
  236.               )
  237.               ( (process el (mapcar '+ bp (list 0.0 (cadadr e))) dx (- dy (cadadr e)))
  238.                 (vl-cmdf "_.undo" "_b")
  239.                 (setq kb (1- kb))
  240.                 (main el (mapcar '+ bp (list 0.0 (cadadr e))) dx (- dy (cadadr e)))
  241.               )
  242.               ( (process el (mapcar '+ bp (list (caadr e) (cadadr e))) (- dx (caadr e)) (- dy (cadadr e)))
  243.                 (vl-cmdf "_.undo" "_b")
  244.                 (setq kb (1- kb))
  245.                 (main el (mapcar '+ bp (list (caadr e) (cadadr e))) (- dx (caadr e)) (- dy (cadadr e)))
  246.               )
  247.               ( t el )
  248.             )
  249.           )
  250.           el
  251.         )
  252.       )
  253.       el
  254.     )
  255.   )
  256.  
  257.   (if (= 8 (logand 8 (getvar 'undoctl)))
  258.     (vla-endundomark adoc)
  259.   )
  260.   (setq cmde (getvar 'cmdecho))
  261.   (setvar 'cmdecho 0)
  262.   (setq ka 0)
  263.   (setq kb 0)
  264.   (if
  265.     (and
  266.       (not (prompt "\nSelect parts for nesting..."))
  267.       (setq ss (ssget "_:L"))
  268.       (not (prompt "\nPick boundary RECTANGLE..."))
  269.       (setq s (ssget "_+.:E:S" (list '(0 . "LWPOLYLINE") '(90 . 4) '(-4 . "&=") '(70 . 1) '(-4 . "<not") '(-4 . "<>") '(42 . 0.0) '(-4 . "not>"))))
  270.     )
  271.     (progn
  272.       (repeat (setq i (sslength ss))
  273.         (setq e (ssname ss (setq i (1- i))))
  274.         (vla-getboundingbox (vlax-ename->vla-object e) 'minpt 'maxpt)
  275.         (mapcar 'set '(minpt maxpt) (mapcar 'safearray-value (list minpt maxpt)))
  276.         (setq dx (- (car maxpt) (car minpt)))
  277.         (setq dy (- (cadr maxpt) (cadr minpt)))
  278.         (setq el (cons (list e (list dx dy) minpt) el))
  279.       )
  280.       (setq lw (ssname s 0))
  281.       (vla-getboundingbox (vlax-ename->vla-object lw) 'minpt 'maxpt)
  282.       (mapcar 'set '(minpt maxpt) (mapcar 'safearray-value (list minpt maxpt)))
  283.       (setq dx (- (car maxpt) (car minpt)))
  284.       (setq dy (- (cadr maxpt) (cadr minpt)))
  285.       (setq bp minpt)
  286.       (setq el (main el bp dx dy))
  287.       (while (and el (setq ll (car l)))
  288.         (setq l (cdr l))
  289.         (mapcar 'set '(bp dx dy) ll)
  290.         (setq el (main el bp dx dy))
  291.       )
  292.       (prompt "\nType \"UNDO\" ") (princ ka) (prompt " for back if you are using AutoCAD...")
  293.       (prompt "\nType \"UNDO\" ") (princ kb) (prompt " for back if you are using BricsCAD...")
  294.     )
  295.   )
  296.   (*error* nil)
  297. )
  298.  

Regards, M.R.
« Last Edit: June 12, 2021, 08:11:17 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

Marc'Antonio Alessi

  • Swamp Rat
  • Posts: 1199
  • Marco
Re: Automatic Nesting for lisp?
« Reply #61 on: July 15, 2021, 09:53:13 AM »
Marko, I tried your program, this is the result:

ribarm

  • Gator
  • Posts: 2519
  • Marko Ribar, architect
Re: Automatic Nesting for lisp?
« Reply #62 on: July 15, 2021, 11:21:33 AM »
Look Marc', there were many attempts for this problem for solution to be found, but all up to now, they were just attempts... I believe that you can get your example solved with my previously posted code and picked smaller rectangle... But that's all... When there are more rectangles that vary in sizes, the task complicate enourmously... I was able to write 2 more algorithms that were similar, but not for nesting - they are for packing in 2d and 3d... I can only say that when you code for this, you must not apply both 2d entities along with 3d ones - they have their geometry specific properties and although you can have 3d algorithm - it does not mean it can be applicable for all... There were some attempts in history called "guilotine cutting" - meaning that when you cut, you can make knife go only straight until piece is choped... Also there were some called non-guilotine where you can position pieces differently than straight, but this thing also complicates tasks... There is online solution finder for big outiline where you can put integer up to 1000 units in both directions and search for all equal smaller pieces where largest piece size is smaller integer than smaller size of outline... Algorithm is probably the best you can use, but the code is hidden from public... For testing here is the link : http://lagrange.ime.usp.br/~lobato/packing/run/index.php
You may also want to read about nesting problems more - there are some articles on www, but I didn't find an ALISP example(s)... So, if you have a time and you are interested in this problem, you can dedicate your time and code for solutions... But be informed that task although may look simple and easy, actually involves deeper understanding of basic geometry and high math skills... So good luck (what can I say different...)...
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

Marc'Antonio Alessi

  • Swamp Rat
  • Posts: 1199
  • Marco
Re: Automatic Nesting for lisp?
« Reply #63 on: July 15, 2021, 11:36:15 AM »
Thanks for your long answer and for your time  :-), i don't think i will try i don't have the mathematical basis to do it.  :nerdyembarassed: