二维下料
本帖最后由 aimisiyou 于 2016-5-2 21:42 编辑;;;;函数（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=*;所以当a是b的倍数时，即a=k*b,则能获得的构件数为n=k**+边角料能获得构件a*b的个数
;;;;最后说明，(a,b)必须经过各自倍增后所得差值最小，如（CL235 123107）结果有误，应先进行（CL 235 12321 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) )
(setqnlist (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 于 2016-11-1 12:33 编辑
;;;函数为(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 于 2016-5-2 15:46 编辑
(CL 1900 1000 350 300)=((2 2 1 0 950) (0 1000))
构件数2*（2+1）^2=18,上限数1900*1000/350/300=18.0952381 谁有下料软件帮我检验下，看看我的结果是不是最优的？如(CL 9000 4000 600 480），若多检测几组当然更加感谢！
本帖最后由 aimisiyou 于 2016-5-2 15:49 编辑
(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 于 2016-5-2 15:55 编辑
(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 发表于 2016-5-1 22:12
要是能自动出图
就好理解了
返回结果已经指明了下料过程，只是将其转化为出图过程有些繁琐，我就没多走一步。
本帖最后由 aimisiyou 于 2016-5-2 16:49 编辑
若求母材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*+*+*=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 于 2016-5-2 18:00 编辑
(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**+*=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))，说明第二部按小构件下料方式可充分利用宽度，此时剩余母板为（958）；显然第三步还是按小构件下料(CL 95 8 10 7)=((9 0 1 1 10) (5 8))，所以总共构件数n=6*+1*(6+5)^2+9*(0+1)^2=280！！！说明充分利用宽度结果反而小了（不是282）
本帖最后由 aimisiyou 于 2016-11-23 22:29 编辑
母材200*100能裁出多少块构件（10*7），答案是285！
本帖最后由 aimisiyou 于 2016-5-2 18:44 编辑
看来(CL DA DB a b)中DA、DB均不能为a、b的倍数才行。那样的话处理起来反而相对简单。以上真是简单问题复杂化了！ 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块
aimisiyou 发表于 2016-5-1 23:51
返回结果已经指明了下料过程，只是将其转化为出图过程有些繁琐，我就没多走一步。
只有块数
结果中的下料过程难以理解
没有图形
别人也不好操作下料的
我有一下自动出图的源码
但块数比你这个少一点
ynhh 发表于 2016-5-3 09:16
只有块数
结果中的下料过程难以理解
没有图形
算法基本成型，逐步完善。正在考虑怎么实现数据与图形间的信息传递及转换。