二维下料

aimisiyou

;;;;函数（CL DA DB a b）中DA——母材长；DB——母材宽；a——构件长；b——构件宽；（DA>=DB,a>b且a不能是b的倍数）
;;;;所得结果为表形式，如(CL 9000 4000 600 480)=((2 5 2 40 3600) (2 3 0 0 1440) (1 1 1 40 1080) (1 1 0 120 480) (1 1 0 40 480) (240 640))
;;;;表中最后一项（240 640）表示最后剩下的一个不能被裁割的废料,第一项如（2 5 2 40 3600）中首项2表示系数，中间5，2表示宽度方向为5a+2b;最后两项40，3600表示经这次裁料后余下的废料边长
;;;;所能得到的构件个数为2*（5+2）^2+2*（3+0）^2+1*（1+1）^2+1*（1+0）^2+1*（1+0）^2=120块,离上限数9000*4000/600/480=125还算接近
;;;;若小构件为正方形a*a，则母板能裁下的构件数为n=[DA/a]*[DB/a];所以当a是b的倍数时，即a=k*b,则能获得的构件数为n=k*[DA/a]*[DB/a]+边角料能获得构件a*b的个数
;;;;最后说明，(a,b)必须经过各自倍增后所得差值最小，如（CL  235 123  10  7）结果有误，应先进行（CL 235 123  21 20），再对废料按（10,7）裁割
(defun ff (n / llist i)
   (setq llist '() i 0)
   (while (<= i n)
       (setq llist (cons i llist))
       (setq i (+ i 1))
    )
    llist
)
(defun qz (x y)
   (setq n (/ (- x (rem x y)) y))
)
(defun zg(DA DB a b)
   (setq nlist nil)
   (foreach na (ff (qz DB a))
        (foreach nb (ff (qz (- DB (* a na)) b))
               (if (and (< (- DB b) (setq sum_A (+ (* a na) (* b nb)))) (>= DB sum_A) )
                   (setq  nlist (cons (list na nb (- DB sum_A) (+ (* b na) (* a nb))) nlist))
               )            
         )
    )
   nlist
)
(defun px(lst)
(car (vl-sort (vl-remove nil (mapcar '(lambda (x) (if (= (caddr x) (apply 'min (mapcar '(lambda (y) (caddr y)) lst) ) ) x nil)) lst)) '(lambda (x y) (> (car x) (car
y))) ))
)
(defun count(DA DB a b)
   (setq lst (px (zg DA DB a b)))
   (setq x (cadr lst))
   (setq y (car lst))
   (setq sum (+ (* a x) (* b y)))
   (if  (= (rem DA sum) 0)
        (setq num (/ DA sum))
        (setq num (+ (/ (- DA DB) sum) 1))
   )
  (cons num lst)
)
(defun CL(DA DB a b)
   (if (or (< DA a) (< DB b))
       (setq lst (list (list DB DA)))
       (setq lst (cons (setq zlst (count DA DB a b)) (CL DB (- DA (* (car zlst)(last zlst))) a b) ))
   )
)
(CL 9100 3800 350 300)

aimisiyou

;;;函数为(clfun (getpoint) n m a b (list 0 nil))
;;;由于递归运行，对于部分（n,m）数据会出现结果异常或栈溢出、访问异常错误情况
;;目前检测正常的数据为(n,1) ,(n,2)、(4,3)、(3+4n,3)、(nk,k)形式的(n,m)      (其中n>=m)
;;;(n,m)=(5,3)时能运行，但结果不正确不知什么情况，看来递归运算出错率很高
(defun drawone(pt a b flag tfx)
  (if flag
    (entmake
      (list
        '(0 . "LWPOLYLINE")                        
        '(100 . "AcDbEntity")
        '(100 . "AcDbPolyline")
        '(90 . 4)                                 
        '(70 . 1)                                 
        (cons 10 (list (car pt) (cadr pt)))
        (cons 10 (list (+ (car pt) a) (cadr pt) ))
        (cons 10 (list (+ (car pt) a) (+ (cadr pt) (* b tfx)) ))
        (cons 10 (list (car pt) (+ (cadr pt) (* b tfx)) )  )                                      
      )
    )
    (entmake
      (list
        '(0 . "LWPOLYLINE")                        
        '(100 . "AcDbEntity")
        '(100 . "AcDbPolyline")
        '(90 . 4)                                 
        '(70 . 1)                                 
        (cons 10 (list (car pt) (cadr pt)))
        (cons 10 (list (+ (car pt) b) (cadr pt) ))
        (cons 10 (list (+ (car pt) b) (+ (cadr pt) (* a tfx)) ))
        (cons 10 (list (car pt) (+ (cadr pt) (* a tfx)) )  )                                      
      )
    )
  )
)
(defun f(pt n a b tfx)
  (if (= n 1)
      (drawone pt a b t tfx)
      (progn
          (f pt 1 a b tfx)
          (setq i 1)
          (while (< i n)
             (setq pt1 (list (car pt) (+ (cadr pt) (* tfx (+ b (* a i) (* a -1))))))
             (setq pt2 (list (+ (car pt) (- a b) (* i b)) (cadr pt) ))
             (drawone pt1 a b nil tfx)
             (drawone pt2 a b nil tfx)  
             (setq i (+ i 1))         
          )
          (f (list (+ (car pt) b) (+ (cadr pt) (* a tfx))) (- n 1) a b tfx)
      )
  )
)
(defun det (n m)
  (setq n1 (/ (+ n 1) 2) n2 (/ n 2) m1 (/ (+ m 1) 2) m2 (/ m 2))
  (setq va (list (list n1 m1) (list n2 m2) (list (- n1 n2) (- m1 m2))))
)
(defun vfun (tmin)
  (setq i 0 vlst nil)
  (while (< i tmin)
     (repeat tmin (setq vlst (cons i vlst)))
     (setq i (+ i 1))
   )
  vlst
)
(defun hfun (tmin)
   (setq j 0 lst nil hlst nil)
   (while (< j tmin)
          (setq lst (cons j lst))  
          (setq j (+ j 1))
    )
   (repeat tmin (setq hlst (append lst hlst)))
   hlst
)
(defun clfun (pt n m a b lst)
  (if (= m 1)
      (if (= (car lst) 0)
          (progn
              (if (member '(0 1) (cdr lst))
                  (f pt (+ n 1) a b 1)
                  (f (list (car pt) (+ (cadr pt) (+ (* n a) b))) (+ n 1) a b -1)
               )
           )
          (progn
             (if (member '(0 1) (cdr lst))
                 (f (list (car pt) (+ (cadr pt) (+ (* n a) b))) (+ n 1) a b -1)
                 (f pt (+ n 1) a b 1)
              )
           )
       )
      (if (> (setq tmin (gcd n m)) 1)
          (mapcar '(lambda (i j)  (clfun (list (+ (car pt)(* i (+ (* a (/ m tmin)) (* b (/ n tmin))))) (+ (cadr pt) (* j (+ (* a (/ n tmin)) (* b (/ m tmin))))))(/ n

tmin) (/ m tmin) a b lst) )  (vfun tmin) (hfun tmin))        
          (progn
            (if (= (car lst) 0)
                 (cond
                   ((equal (cdr lst) (list nil))
                    (progn
                      (setq dlst (det n m) nd (car (car dlst)) md (cadr (car dlst)) nx (car (cadr dlst)) mx (cadr (cadr dlst)) )
                      (clfun pt nd md a b (cons 0 (list (caddr (det n m)))))
                      (clfun (polar pt 0 (+ (* a md) (* b nd)) ) nx mx a b (cons 1 (list nil)))
                      (clfun (polar pt (/ pi 2) (+ (* a nd) (* b md))) nx mx a b (cons 1 (list nil)))
                      (clfun (list (+ (car pt) (+ (* a mx) (* b nx)))(+ (cadr pt)(+ (* a nx) (* b mx)))) nd md a b (cons 0 (list (caddr (det n m)))))
                     )
                   )
                  ((equal (car (cdr lst)) (list 1 1))                                                           
                   (if (and (= (- n m) 1) (= (rem m 2) 0))                                                      
                       (progn
                         (setq dlst (det n m) nd (car (car dlst)) md (cadr (car dlst)) nx (car (cadr dlst)) mx (cadr (cadr dlst)))
                         (clfun pt nx mx a b (cons 0 (cdr lst)))
                         (clfun (polar pt 0 (+ (* a mx) (* b nx)) ) nd md a b (cons 1 (list (caddr (det n m)))))
                         (clfun (polar pt (/ pi 2) (+ (* a nx) (* b mx))) nd md a b (cons 1 (list (caddr (det n m)))))
                         (clfun (list (+ (car pt) (+ (* a md) (* b nd)))(+ (cadr pt) (+ (* a nd) (* b md)))) nx mx a b (cons 0 (cdr lst)))
                        )
                        (progn
                           (setq dlst (det n m) nd (car (car dlst)) md (cadr (car dlst)) nx (car (cadr dlst)) mx (cadr (cadr dlst)))            
                           (clfun pt nd md a b (cons 0 (cons (caddr (det n m)) (cdr lst))))
                           (clfun (polar pt 0 (+ (* a md) (* b nd)) ) nx mx a b (cons 1 (list nil)))
                           (clfun (polar pt (/ pi 2) (+ (* a nd) (* b md))) nx mx a b (cons 1 (list nil)))
                           (clfun (list (+ (car pt) (+ (* a mx) (* b nx)))(+ (cadr pt) (+ (* a nx) (* b mx)))) nd md a b (cons 0 (cons (caddr (det n m)) (cdr lst))))
                         )
                      )
                    )
                   ((equal (car (cdr lst)) (list 1 0))
                     (if (equal (caddr (det n m)) (list 1 0) )
                         (progn
                            (setq dlst (det n m) nd (car (car dlst)) md (cadr (car dlst)) nx (car (cadr dlst)) mx (cadr (cadr dlst)))
                            (clfun pt nd md a b (cons 0 (cons (caddr (det n m)) (cdr lst))))
                            (clfun (polar pt 0 (+ (* a md) (* b nd)) ) nx mx a b (cons 1 (list nil)))
                            (clfun (polar pt (/ pi 2) (+ (* a nd) (* b md))) nx mx a b (cons 1 (list nil)))
                            (clfun (list (+ (car pt) (+ (* a mx) (* b nx)))  (+ (cadr pt) (+ (* a nx) (* b mx)))  ) nd md a b (cons 0 (cons (caddr (det n m)) (cdr

lst))))
                           )
                          (progn
                             (setq dlst (det n m) nd (car (car dlst)) md (cadr (car dlst)) nx (car (cadr dlst)) mx (cadr (cadr dlst)))
                             (clfun pt nd md a b (cons 0 (cdr lst)))
                             (clfun (polar pt 0 (+ (* a md) (* b nd)) ) nx mx a b (cons 1 (list (caddr (det n m)))))
                             (clfun (polar pt (/ pi 2) (+ (* a nd) (* b md))) nx mx a b (cons 1 (list (caddr (det n m)))))
                             (clfun (list (+ (car pt) (+ (* a mx) (* b nx)))  (+ (cadr pt) (+ (* a nx) (* b mx)))) nd md a b (cons 0  (cdr lst)))
                            )
                          )
                       )     
                      ((equal (car (cdr lst)) (list 0 1))
                              (if (equal (caddr  (det n m)) (list 0 1))
                                  (progn
                                     (setq dlst (det n m) nd (car (car dlst)) md (cadr (car dlst)) nx (car (cadr dlst)) mx (cadr (cadr dlst)))
                                     (clfun pt nd md a b (cons 0 (cons (caddr (det n m)) (cdr lst))))
                                     (clfun (polar pt 0 (+ (* a md) (* b nd))) nx mx a b (cons 1 (list nil)))
                                     (clfun (polar pt (/ pi 2) (+ (* a nd) (* b md))) nx mx a b (cons 1 (list nil)))
                                     (clfun (list (+ (car pt) (+ (* a mx) (* b nx)))  (+ (cadr pt) (+ (* a nx) (* b mx)))  ) nd md a b (cons 0 (cons (caddr (det n m))

(cdr lst))))
                                    )
                                   (progn
                                      (setq dlst (det n m) nd (car (car dlst)) md (cadr (car dlst)) nx (car (cadr dlst)) mx (cadr (cadr dlst)))
                                      (clfun pt nx mx a b lst)
                                      (clfun (polar pt 0 (+ (* a mx) (* b nx)) ) nd md a b (cons 1 (list (caddr  (det n m)))))
                                      (clfun (polar pt (/ pi 2) (+ (* a nx) (* b mx))) nd md a b (cons 1 (list (caddr  (det n m)))))
                                      (clfun (list (+ (car pt) (+ (* a md) (* b nd)))  (+ (cadr pt) (+ (* a nd) (* b md)))) nx mx a b lst)
                                    )
                                )
                         )
                   )
                  (cond
                     ((equal (cdr lst) (list nil))
                             (progn
                                (setq dlst (det n m) nd (car (car dlst)) md (cadr (car dlst)) nx (car (cadr dlst)) mx (cadr (cadr dlst)))
                                (clfun pt nd md a b (cons 0 (list (caddr (det n m)))))
                                (clfun (polar pt 0 (+ (* a md) (* b nd)) ) nx mx a b (cons 1 (list nil)))
                                (clfun (polar pt (/ pi 2) (+ (* a nd) (* b md))) nx mx a b (cons 1 (list nil)))
                                (clfun (list (+ (car pt) (+ (* a mx) (* b nx)))  (+ (cadr pt) (+ (* a nx) (* b mx)))  ) nd md a b (cons 0 (list (caddr (det n m)))))
                              )
                                  )
                     ( (equal (car (cdr lst)) (list 1 1))
                       (if (and (= (- n m) 1) (= (rem m 2) 0))                                                      
                           (progn
                              (setq dlst (det n m) nd (car (car dlst)) md (cadr (car dlst)) nx (car (cadr dlst)) mx (cadr (cadr
dlst)))
                              (clfun pt nd md a b (cons 0 (list (caddr (det n m)))))
                              (clfun (polar pt 0 (+ (* a md) (* b nd)) ) nx mx a b (cons 1 (cdr lst)))
                              (clfun (polar pt (/ pi 2) (+ (* a nd) (* b md))) nx mx a b (cons 1 (cdr lst)))
                              (clfun (list (+ (car pt) (+ (* a mx) (* b nx)))  (+ (cadr pt) (+ (* a nx) (* b mx)))) nd md a b (cons 0 (list (caddr (det n m)))))
                            )
                           (progn
                              (setq dlst (det n m) nd (car (car dlst)) md (cadr (car dlst)) nx (car (cadr dlst)) mx (cadr (cadr
dlst)))                                                        
                              (clfun pt nx mx a b (cons 0 (list nil)))
                              (clfun (polar pt 0 (+ (* a mx) (* b nx)) ) nd md a b (cons 1 (cons (caddr (det n m)) (cdr lst))))
                              (clfun (polar pt (/ pi 2) (+ (* a nx) (* b mx))) nd md a b (cons 1 (cons (caddr (det n m)) (cdr lst))))
                             (clfun (list (+ (car pt) (+ (* a md) (* b nd))) (+ (cadr pt) (+ (* a nd) (* b md)))) nd md a b (cons 0 (list nil)))
                            )
                         )
                   )
                   ( (equal (car (cdr lst)) (list 1 0))
                     (if (equal (caddr (det n m)) (list 1 0) )
                         (progn
                            (setq dlst (det n m) nd (car (car dlst)) md (cadr (car dlst)) nx (car (cadr dlst)) mx (cadr (cadr dlst)))
                            (clfun pt nx mx a b (cons 0 (list nil)))
                            (clfun (polar pt 0 (+ (* a mx) (* b nx)) ) nd md a b (cons 1 (cons (caddr (det n m)) (cdr lst))))
                            (clfun (polar pt (/ pi 2) (+ (* a nx) (* b mx))) nd md a b (cons 1 (cons (caddr (det n m)) (cdr lst))))
                           (clfun (list (+ (car pt) (+ (* a md) (* b nd)))  (+ (cadr pt) (+ (* a nd) (* b md)))  ) nx mx a b (cons 0 (list nil)))
                          )
                         (progn
                            (setq dlst (det n m) nd (car (car dlst)) md (cadr (car dlst)) nx (car (cadr dlst)) mx (cadr (cadr dlst)))
                            (clfun pt nd md a b (cons 0 (list (caddr (det n m)))))
                            (clfun (polar pt 0 (+ (* a md) (* b nd)) ) nx mx a b (cons 1 (cdr lst)))
                            (clfun (polar pt (/ pi 2) (+ (* a nd) (* b md))) nx mx a b (cons 1 (cdr lst)))
                            (clfun (list (+ (car pt) (+ (* a mx) (* b nx))) (+ (cadr pt) (+ (* a nx) (* b mx)))) nd md a b (cons 0 (list (caddr (det n m)))))
                           )
                        )
                    )     
                   ( (equal (car (cdr lst)) (list 0 1))
                     (if (equal (caddr (det n m)) (list 0 1))
                         (progn
                             (setq dlst (det n m) nd (car (car dlst)) md (cadr (car dlst)) nx (car (cadr dlst)) mx (cadr (cadr dlst)))
                             (clfun pt nx mx a b (cons 0 (list nil)))
                             (clfun (polar pt 0 (+ (* a mx) (* b nx)) ) nd md a b (cons 1 (cons (caddr (det n m)) (cdr lst))))
                             (clfun (polar pt (/ pi 2) (+ (* a nx) (* b mx))) nd md a b (cons 1 (cons (caddr (det n m)) (cdr
lst))))
                             (clfun (list (+ (car pt) (+ (* a md) (* b nd)))  (+ (cadr pt) (+ (* a nd) (* b md)))) nx mx a b (cons 0 (list nil)))
                           )
                          (progn
                               (setq dlst (det n m) nd (car (car dlst)) md (cadr (car dlst)) nx (car (cadr dlst)) mx (cadr (cadr dlst)))
                               (clfun pt nd md a b (cons 0 (list (caddr (det n m)))))
                               (clfun (polar pt 0 (+ (* a md) (* b nd)) ) nx mx a b (cons 1 (cdr lst)))
                               (clfun (polar pt (/ pi 2) (+ (* a nd) (* b md))) nx mx a b (cons 1 (cdr lst)))
                               (clfun (list (+ (car pt) (+ (* a mx) (* b nx))) (+ (cadr pt) (+ (* a nx) (* b mx)))) nd md a b (cons 0 (list (caddr (det n m)))))
                            )
                        )                    
                    )                                          
                 )
               )
            )
         )
    )
)
(clfun (getpoint) 4 3 10 6 (list 0 nil))

aimisiyou

(CL 1900 1000 350 300)=((2 2 1 0 950) (0 1000))
构件数2*（2+1）^2=18,上限数1900*1000/350/300=18.0952381

aimisiyou

谁有下料软件帮我检验下，看看我的结果是不是最优的？如(CL 9000 4000 600 480），若多检测几组当然更加感谢！

aimisiyou

(CL 2000 1000 360 300)=((1 1 2 40 1020) (1 1 2 20 1020) (-20 980))
看来最后项若出现负值，根据返回表所指明的下料顺序，构件数还得减少（1 1 2 20）中间两项之和1+2=3，即构件数=1*（1+2）^2+1*（1+2）^2-（1+2）=15

aimisiyou

(CL 20000 10000 350 300)=((2 26 3 0 8850) (4 4 3 0 2250) (2 2 1 0 950) (3 1 0 50 300) (100 400))
构件数n=2*(26+3)^2+4*(4+3)^2+2*(2+1)^2+3*(1+0)^2=1899
上限数为20000*10000/350/300=1904

ynhh

要是能自动出图
就好理解了

marting

二维下料的算法据说挺复杂，手头没下料软件，帮楼主顶下，支持下。

aimisiyou

ynhh 发表于 2016-5-1 22:12
要是能自动出图
就好理解了

返回结果已经指明了下料过程，只是将其转化为出图过程有些繁琐，我就没多走一步。

aimisiyou

若求母材200*100能裁出多少块构件（10*7），因为21*20=6*（10*7）
（CL 200 100 21 20）=((1 0 5 0 105) (1 4 0 11 80) (4 0 1 0 21) (11 20))，即余料有1个（11,80）,1个（11,20）
故构件数n=6*[1*(0+5)^2+1*(4+0)^2+4*(0+1)^2]+[11/10]*[80/7]+[11/10]*[20/7]=282
上限数200*100/10/7=285
而(CL 200 100 10 7)=((2 10 0 0 70) (1 6 0 0 42) (1 3 4 0 61) (-1 58))
计算得n=2*(10+0)^2+1*(6+0)^2+1*(3+4)^2-(3+4)=278

aimisiyou

(CL 200 100 9 7)=((2 8 4 0 92) (6 1 1 0 16) (4 16))
n=2*(8+4)^2+6*(1+1)^2=312

28*27=（4*7）*（3*9）=12*（9*7）
(CL 200 100 28 27)=((2 3 0 16 81) (3 1 0 10 27) (19 38))
n=12*[2*(3+0)^2+3*(1+0)^2]+2*[16/7]*[81/9]+3*[10/7]*[27/9]+[19/9]*[38/7]=307
上限数n=200*100/9/7=317

按大构件（28，27）下料所得数目反而变小了，因为第一次裁料后剩余2个（16,81）最小数16大于（9,7）中最大值9，说明没有充分利用宽度，而按小构件（9,7）第一次下料得（2 8 4 0 92），宽度充分利用了！！！

(CL 200 100 10 7)=((2 10 0 0 70) (1 6 0 0 42) (1 3 4 0 61) (-1 58)) 按小构件（10,7）裁料第一次充分利用了宽度
(CL 200 100 21 20)=((1 0 5 0 105) (1 4 0 11 80) (4 0 1 0 21) (11 20))按大构件（21,20）裁料第一次也充分利用了宽度，说明第一次裁料时须比较按大构件还是按小构件方式，当都能充分利用宽度时采用按大构件方式下料！！依次往下比较。

再对母板200*100裁成10*7的构件换个下料方式：
首先第一步按大构件，结果（1 0 5 0 105），宽度充分利用，剩下的母板为（100,95）；(CL 100 95 10 7)=((1 6 5 0 92) (9 0 1 1 10) (5 8))，(CL 100 95 21 20)=((1 4 0 11 80) (4 0 1 0 21) (11 20))，说明第二部按小构件下料方式可充分利用宽度，此时剩余母板为（95  8）；显然第三步还是按小构件下料(CL 95 8 10 7)=((9 0 1 1 10) (5 8))，所以总共构件数n=6*[1*(0+5)^2]+1*(6+5)^2+9*(0+1)^2=280！！！说明充分利用宽度结果反而小了（不是282）

aimisiyou

母材200*100能裁出多少块构件（10*7），答案是285！

aimisiyou

看来(CL DA DB a b)中DA、DB均不能为a、b的倍数才行。那样的话处理起来反而相对简单。以上真是简单问题复杂化了！

aimisiyou

aimisiyou 发表于 2016-5-1 20:35
谁有下料软件帮我检验下，看看我的结果是不是最优的？如(CL 9000 4000 600 480），若多检测几组当然更加感 ...

9000=15*600
4000=7*480+1*600+40
9000=480*18+60
故最优数n=15*7+1*18=123块

ynhh

aimisiyou 发表于 2016-5-1 23:51
返回结果已经指明了下料过程，只是将其转化为出图过程有些繁琐，我就没多走一步。

只有块数
结果中的下料过程难以理解
没有图形
别人也不好操作下料的
我有一下自动出图的源码
但块数比你这个少一点

aimisiyou

ynhh 发表于 2016-5-3 09:16
只有块数
结果中的下料过程难以理解
没有图形

算法基本成型，逐步完善。正在考虑怎么实现数据与图形间的信息传递及转换。