二维下料

aimisiyou · 发表于 2016-12-11 11:37:07

本帖最后由 aimisiyou 于 2016-12-11 13:27 编辑

给出（29,26）、（53,24）、（53,22）的分解图。

aimisiyou · 发表于 2017-2-7 21:27:21

aimisiyou 发表于 2016-12-11 10:41

分解图有点小问题，（57，6）=（19，2）=（10,1）+（9,1）

aimisiyou · 发表于 2017-2-17 20:25:16

本帖最后由 aimisiyou 于 2017-5-14 15:59 编辑

;;;注意满足a>b>0！！！（n,m）为任意自然数。
(defun c:tt()
;;;(t 1)横上；(t -1)横下；(nil 1)竖上；(nil -1)竖下；
(defun f(pt n a b flag tfx)
  (if (= n 1)
   (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))))
            )
         )
      )
   (progn
      (f pt 1 a b flag tfx)
      (setq i 1)
      (while (< i n)
         (setq pt1 (list (car pt) (+ (cadr pt) (* tfx (+ (if flag b a) (* (if flag a b) -1) (* (if flag a b) i))))))
         (setq pt2 (list (+ (car pt) (- (if flag a b) (if flag b a)) (* i (if flag b a))) (cadr pt)))
         (f pt1 1 a b (not flag) tfx)
         (f pt2 1 a b (not flag) tfx)
         (setq i (+ i 1))
      )
      (f (list (+ (car pt) (if flag b a)) (+ (cadr pt) (* (if flag a b) tfx))) (- n 1) a b flag tfx)
   )
)
)
(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 llst nil hlst nil)
(while (< j tmin)
      (setq llst (cons j llst))
      (setq j (+ j 1))
)
(repeat tmin (setq hlst (append llst hlst)))
hlst
)
(defun clfun1 (pt n m a b lst)
(if (< n m)
(clfun1 pt m n b a lst)
(if (= m 1)
  (if (= (car lst) 0)
   (f pt (+ n 1) a b t 1)
   (if (= (car (cdr lst)) '(1 0))
      (f (list (car pt) (+ (cadr pt) (+ (* n a) b))) (+ n 1) a b t -1)
      (f pt (+ n 1) a b t 1)
      )
)
  (if (> (gcd n m) 1)
   (mapcar '(lambda (i j) (clfun1 (list (+ (car pt)(* i (+ (* a (/ m (gcd n m))) (* b (/ n (gcd n m)))))) (+ (cadr pt) (* j (+ (* a (/ n (gcd n m))) (* b (/ m (gcd n m)))))))(/ n (gcd n m)) (/ m (gcd n m)) a b lst)) (vfun (gcd n m)) (hfun (gcd n m)))
   (if (equal (cdr lst) (list nil))
            (if (and (= (rem n 2) 1) (= (rem m 2) 0))
      (progn
      (clfun1 pt (/ n 2) (/ m 2) a b (cons 0 (list nil)))
      (clfun1 (polar pt 0 (+ (* a (/ m 2)) (* b (/ n 2)))) (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 1 (list '(1 0))))
      (clfun1 (polar pt (/ pi 2) (+ (* a (/ n 2)) (* b (/ m 2)))) (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 1 (list '(1 0))))
      (clfun1 (list (+ (car pt) (+ (* a (/ (+ m 1) 2)) (* b (/ (+ n 1) 2))))(+ (cadr pt)(+ (* a (/ (+ n 1) 2)) (* b (/ (+ m 1) 2))))) (/ n 2) (/ m 2) a b (cons 0 (list nil)))
      )
      (progn
      (clfun1 pt (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 0 (list (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2))))))
      (clfun1 (polar pt 0 (+ (* a (/ (+ m 1) 2)) (* b (/ (+ n 1) 2)))) (/ n 2) (/ m 2) a b (cons 1 (list nil)))
      (clfun1 (polar pt (/ pi 2) (+ (* a (/ (+ n 1) 2)) (* b (/ (+ m 1) 2)))) (/ n 2) (/ m 2) a b (cons 1 (list nil)))
      (clfun1 (list (+ (car pt) (+ (* a (/ m 2)) (* b (/ n 2))))(+ (cadr pt)(+ (* a (/ n 2)) (* b (/ m 2))))) (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 0 (list (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2))))))
      )
               )
      (if (= (car (cdr lst)) '(1 0))
   (if (and (= (rem n 2) 1) (= (rem m 2) 0))
      (progn
      (clfun1 pt (/ n 2) (/ m 2) a b (cons 0 (list nil)))
      (clfun1 (polar pt 0 (+ (* a (/ m 2)) (* b (/ n 2)))) (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 1 (list '(1 0))))
      (clfun1 (polar pt (/ pi 2) (+ (* a (/ n 2)) (* b (/ m 2)))) (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 1 (list '(1 0))))
      (clfun1 (list (+ (car pt) (+ (* a (/ (+ m 1) 2)) (* b (/ (+ n 1) 2))))(+ (cadr pt)(+ (* a (/ (+ n 1) 2)) (* b (/ (+ m 1) 2))))) (/ n 2) (/ m 2) a b (cons 0 (list nil)))
      )
      (progn
      (clfun1 pt (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 0 (list (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2))))))
      (clfun1 (polar pt 0 (+ (* a (/ (+ m 1) 2)) (* b (/ (+ n 1) 2)))) (/ n 2) (/ m 2) a b (cons 1 (list '(1 0))))
      (clfun1 (polar pt (/ pi 2) (+ (* a (/ (+ n 1) 2)) (* b (/ (+ m 1) 2)))) (/ n 2) (/ m 2) a b (cons 1 (list '(1 0))))
      (clfun1 (list (+ (car pt) (+ (* a (/ m 2)) (* b (/ n 2))))(+ (cadr pt)(+ (* a (/ n 2)) (* b (/ m 2))))) (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 0 (list (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2))))))
      )
         )
   (if (and (= (rem n 2) 1) (= (rem m 2) 0))
      (progn
               (clfun1 pt (/ n 2) (/ m 2) a b (cons 0 (cdr lst)))
      (clfun1 (polar pt 0 (+ (* a (/ m 2)) (* b (/ n 2)))) (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 1 (list '(1 0))))
      (clfun1 (polar pt (/ pi 2) (+ (* a (/ n 2)) (* b (/ m 2)))) (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 1 (list '(1 0))))
      (clfun1 (list (+ (car pt) (+ (* a (/ (+ m 1) 2)) (* b (/ (+ n 1) 2))))(+ (cadr pt)(+ (* a (/ (+ n 1) 2)) (* b (/ (+ m 1) 2))))) (/ n 2) (/ m 2) a b (cons 0 (cdr lst)))
      )
      (progn
      (clfun1 pt (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 0 (list (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2))))))
      (clfun1 (polar pt 0 (+ (* a (/ (+ m 1) 2)) (* b (/ (+ n 1) 2)))) (/ n 2) (/ m 2) a b (cons 1 (list nil)))
      (clfun1 (polar pt (/ pi 2) (+ (* a (/ (+ n 1) 2)) (* b (/ (+ m 1) 2)))) (/ n 2) (/ m 2) a b (cons 1 (list nil)))
      (clfun1 (list (+ (car pt) (+ (* a (/ m 2)) (* b (/ n 2))))(+ (cadr pt)(+ (* a (/ n 2)) (* b (/ m 2))))) (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 0 (list (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2))))))
      )
         )
      )
      )
      )
      )
  )
  )
(setq ppt (getpoint "\n插入点位置："))
(setq nn (getint "\nn=：") mm (getint "\nm=：") aa (getint "\na=：") bb (getint "\nb=："))
(clfun1 ppt nn mm aa bb (list 0 nil))
)

aimisiyou · 发表于 2017-2-17 23:19:30

本帖最后由 aimisiyou 于 2017-2-18 13:08 编辑

(defun fl (DA DB a b)
(setq n1 (/ DA a) det (- a b) n2 (rem DA a) n3 (/ (- a n2) det) let1 (rem (- a n2) det))
(if (= let1 0)
   (setq va (list (- n1 n3 -1) n3 0))
   (setq va (list (- n1 n3) (+ n3 1) (- a b let1)))
      )
(setq nn1 (/ DB b) nn2 (/ (rem DB b) det) let2 (rem (rem DB b) det))
(setq vb (list (- nn1 nn2) nn2 let2))
(list va vb)
)

(fl 194 153 10 7)
((18 2 0) (19 2 0))
(fl 153 194 10 7)
((13 3 2) (26 1 2))

aimisiyou · 发表于 2017-2-17 23:30:17

本帖最后由 aimisiyou 于 2017-2-18 00:14 编辑

优先考虑第三位（即剩余边长度）越小越好，均为0最好。利用率100%的情况时((na 0 0）(nb 0 0)）,再次是((na1 nb1 0）(nb2 na2 0)）.若d=gcd(a,b)，则有kb=b/d,ka=a/d,要求((na1,nb1,0)(nb2,na2,0))最优解，即转化为求(((rem na1 kb),nb1,0)((rem nb2 ka),na2,0))的最优解问题。

aimisiyou · 发表于 2017-2-19 23:27:09

本帖最后由 aimisiyou 于 2017-2-20 00:09 编辑

;;;确保将长度L分解成a,b线性组合后的剩余长度最短且a的系数取到最大值
(defun ff (L a b)
  (setq flag t det (rem L (gcd a b)) x (/ (- L det) a) )
  (while (and (> x 0) flag)
      (setq k (- L det (* x a)))
      (if (= (rem k b) 0)
         (setq flag nil)
         (setq x (- x 1))
      )
)
(if (/= x 0)
   (setq va (list x (/ k b) det))
   (if (= (rem L b) 0)
         (setq va (list 0 (/ L b) 0))
         (progn
            (setq j 1)
            (while (/= (last (ff (- L j) a b)) 0)
                  (setq j (+ 1 j))
            )
            (setq va (mapcar '+ (ff (- L j) a b) (list 0 0 j)))
         )
      )
)
)
(ff 33 10 7)
(1 3 2)

(ff 133 40 27)
(1 3 12)

pengfei2010 · 发表于 2017-5-26 12:46:10

楼主真心厉害，这么持之以恒

ynhh · 发表于 2017-8-16 16:45:57

楼主这个二维的
最终结果定型了吗

aimisiyou · 发表于 2017-8-16 17:17:50

ynhh 发表于 2017-8-16 16:45

这个仅仅是对单一矩形构件而言，现实中矩形构件多样，算法也就更复杂了。

aimisiyou · 发表于 2017-12-15 23:31:18

搁浅了很久，一是由于觉得基本实现了半自动化（当然复杂的判断情形，人工处理更简单高效），二是完全实现自动化没有好的思路，对于追求完美的人来说，如鲠在喉。最近好像有些灵光一现的感觉，该好好整理思路了。

aimisiyou · 发表于 2017-12-15 23:43:42

本帖最后由 aimisiyou 于 2017-12-19 00:41 编辑

;;;运行结果可能不正确（运气好的情况除外），权当试验结果。
(defun c:tt()

(defun f(pt n a b flag tfx)
  (if (= n 1)
   (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))))
            )
         )
      )
   (progn
      (f pt 1 a b flag tfx)
      (setq i 1)
      (while (< i n)
         (setq pt1 (list (car pt) (+ (cadr pt) (* tfx (+ (if flag b a) (* (if flag a b) -1) (* (if flag a b) i))))))
         (setq pt2 (list (+ (car pt) (- (if flag a b) (if flag b a)) (* i (if flag b a))) (cadr pt)))
         (f pt1 1 a b (not flag) tfx)
         (f pt2 1 a b (not flag) tfx)
         (setq i (+ i 1))
      )
      (f (list (+ (car pt) (if flag b a)) (+ (cadr pt) (* (if flag a b) tfx))) (- n 1) a b flag tfx)
   )
)
)
(defun drawone (pt a b)
(f pt 1 a b t 1)

)
(defun drawmore (ppt n m a b)
   (setq i 0 j 0)
   (while (< i n)
            (while (< j m)
                  (drawone (list (+ (car ppt) (* i a)) (+ (cadr ppt) (* j b))) a b)
                  (setq j (+ j 1))
            )
            (setq i (+ i 1) j 0)
   )
)
(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 llst nil hlst nil)
(while (< j tmin)
      (setq llst (cons j llst))
      (setq j (+ j 1))
)
(repeat tmin (setq hlst (append llst hlst)))
hlst
)
(defun ff (L a b flag)
(setq i 0 flst nil)
(while (<= (* a i) L)
         (setq flst (cons (list i (/ (- L (* i a)) b) (rem (- L (* i a)) b)) flst))
         (setq i (+ i 1))
)
(setq lst (vl-sort flst '(lambda (x y)  (<= (caddr x) (caddr y)) ) ) )
(setq nmin (caddr (car lst)))
(if flag
   (progn
         (setq flst (vl-remove-if-not '(lambda (x) (= (caddr x) nmin)) lst) )
         (setq flst (vl-sort flst '(lambda (x y) (> (car x) (car y)) ) ) )
         (setq va (car flst))
         (if (= (car va) 0)
            (progn
               (setq flst (vl-remove-if '(lambda (x) (= (caddr x) nmin)) lst))
               (setq nmin (caddr (car flst)))
               (setq flst (vl-remove-if-not '(lambda (x) (= (caddr x) nmin)) flst) )
               (setq flst (vl-sort flst '(lambda (x y) (> (car x) (car y)) ) ))
               (setq va (car flst))
            )
         )
      )
   (progn
         (setq lst (vl-remove-if-not '(lambda (x) (= (caddr x) nmin)) lst) )
         (setq lst (vl-sort lst '(lambda (x y) (> (car x) (car y)) ) ) )
         (setq va (car lst))
      )
   )
   va
)
(defun frem (L a b)
(setq sn (/ (* a b) (gcd a b)))
(list (/ L sn) sn (rem L sn))
)

(defun clfun (pt n m a b lst)
(if (< n m)
(clfun pt m n b a lst)
(if (= m 1)
  (if (= (car lst) 0)
   (f pt (+ n 1) a b t 1)
   (if (= (car (cdr lst)) '(1 0))
      (f (list (car pt) (+ (cadr pt) (+ (* n a) b))) (+ n 1) a b t -1)
      (f pt (+ n 1) a b t 1)
      )
)
  (if (> (gcd n m) 1)
   (mapcar '(lambda (i j) (clfun (list (+ (car pt)(* i (+ (* a (/ m (gcd n m))) (* b (/ n (gcd n m)))))) (+ (cadr pt) (* j (+
(* a (/ n (gcd n m))) (* b (/ m (gcd n m)))))))(/ n (gcd n m)) (/ m (gcd n m)) a b lst)) (vfun (gcd n m)) (hfun (gcd n m)))
   (if (equal (cdr lst) (list nil))
            (if (and (= (rem n 2) 1) (= (rem m 2) 0))
      (progn
      (clfun pt (/ n 2) (/ m 2) a b (cons 0 (list nil)))
      (clfun (polar pt 0 (+ (* a (/ m 2)) (* b (/ n 2)))) (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 1 (list '(1 0))))
      (clfun (polar pt (/ pi 2) (+ (* a (/ n 2)) (* b (/ m 2)))) (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 1 (list '(1 0))))
      (clfun (list (+ (car pt) (+ (* a (/ (+ m 1) 2)) (* b (/ (+ n 1) 2))))(+ (cadr pt)(+ (* a (/ (+ n 1) 2)) (* b (/ (+ m 1)
2))))) (/ n 2) (/ m 2) a b (cons 0 (list nil)))
      )
      (progn
      (clfun pt (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 0 (list (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2))))))
      (clfun (polar pt 0 (+ (* a (/ (+ m 1) 2)) (* b (/ (+ n 1) 2)))) (/ n 2) (/ m 2) a b (cons 1 (list nil)))
      (clfun (polar pt (/ pi 2) (+ (* a (/ (+ n 1) 2)) (* b (/ (+ m 1) 2)))) (/ n 2) (/ m 2) a b (cons 1 (list nil)))
      (clfun (list (+ (car pt) (+ (* a (/ m 2)) (* b (/ n 2))))(+ (cadr pt)(+ (* a (/ n 2)) (* b (/ m 2))))) (/ (+ n 1) 2) (/
(+ m 1) 2) a b (cons 0 (list (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2))))))
      )
               )
      (if (= (car (cdr lst)) '(1 0))
   (if (and (= (rem n 2) 1) (= (rem m 2) 0))
      (progn
      (clfun pt (/ n 2) (/ m 2) a b (cons 0 (list nil)))
      (clfun (polar pt 0 (+ (* a (/ m 2)) (* b (/ n 2)))) (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 1 (list '(1 0))))
      (clfun (polar pt (/ pi 2) (+ (* a (/ n 2)) (* b (/ m 2)))) (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 1 (list '(1 0))))
      (clfun (list (+ (car pt) (+ (* a (/ (+ m 1) 2)) (* b (/ (+ n 1) 2))))(+ (cadr pt)(+ (* a (/ (+ n 1) 2)) (* b (/ (+ m 1)
2))))) (/ n 2) (/ m 2) a b (cons 0 (list nil)))
      )
      (progn
      (clfun pt (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 0 (list (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2))))))
      (clfun (polar pt 0 (+ (* a (/ (+ m 1) 2)) (* b (/ (+ n 1) 2)))) (/ n 2) (/ m 2) a b (cons 1 (list '(1 0))))
      (clfun (polar pt (/ pi 2) (+ (* a (/ (+ n 1) 2)) (* b (/ (+ m 1) 2)))) (/ n 2) (/ m 2) a b (cons 1 (list '(1 0))))
      (clfun (list (+ (car pt) (+ (* a (/ m 2)) (* b (/ n 2))))(+ (cadr pt)(+ (* a (/ n 2)) (* b (/ m 2))))) (/ (+ n 1) 2) (/
(+ m 1) 2) a b (cons 0 (list (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2))))))
      )
         )
   (if (and (= (rem n 2) 1) (= (rem m 2) 0))
      (progn
               (clfun pt (/ n 2) (/ m 2) a b (cons 0 (cdr lst)))
      (clfun (polar pt 0 (+ (* a (/ m 2)) (* b (/ n 2)))) (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 1 (list '(1 0))))
      (clfun (polar pt (/ pi 2) (+ (* a (/ n 2)) (* b (/ m 2)))) (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 1 (list '(1 0))))
      (clfun (list (+ (car pt) (+ (* a (/ (+ m 1) 2)) (* b (/ (+ n 1) 2))))(+ (cadr pt)(+ (* a (/ (+ n 1) 2)) (* b (/ (+ m 1)
2))))) (/ n 2) (/ m 2) a b (cons 0 (cdr lst)))
      )
      (progn
      (clfun pt (/ (+ n 1) 2) (/ (+ m 1) 2) a b (cons 0 (list (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2))))))
      (clfun (polar pt 0 (+ (* a (/ (+ m 1) 2)) (* b (/ (+ n 1) 2)))) (/ n 2) (/ m 2) a b (cons 1 (list nil)))
      (clfun (polar pt (/ pi 2) (+ (* a (/ (+ n 1) 2)) (* b (/ (+ m 1) 2)))) (/ n 2) (/ m 2) a b (cons 1 (list nil)))
      (clfun (list (+ (car pt) (+ (* a (/ m 2)) (* b (/ n 2))))(+ (cadr pt)(+ (* a (/ n 2)) (* b (/ m 2))))) (/ (+ n 1) 2) (/
(+ m 1) 2) a b (cons 0 (list (list (- (/ (+ n 1) 2) (/ n 2)) (- (/ (+ m 1) 2) (/ m 2))))))
      )
         )
      )
      )
      )
      )
  )
  )
(defun frem (L a b)
(setq sn (/ (* a b) (gcd a b)))
(list (/ L sn) sn (rem L sn))
)
(defun ff (L a b flag)
(setq i 0 flst nil)
(while (<= (* a i) L)
         (setq flst (cons (list i (/ (- L (* i a)) b) (rem (- L (* i a)) b)) flst))
         (setq i (+ i 1))
)
(setq lst (vl-sort flst '(lambda (x y)  (<= (caddr x) (caddr y)) ) ) )
(setq nmin (caddr (car lst)))
(if flag
   (progn
         (setq flst (vl-remove-if-not '(lambda (x) (= (caddr x) nmin)) lst) )
         (setq flst (vl-sort flst '(lambda (x y) (> (car x) (car y)) ) ) )
         (setq va (car flst))
         (if (= (car va) 0)
            (progn
               (setq flst (vl-remove-if '(lambda (x) (= (caddr x) nmin)) lst))
               (setq nmin (caddr (car flst)))
               (setq flst (vl-remove-if-not '(lambda (x) (= (caddr x) nmin)) flst) )
               (setq flst (vl-sort flst '(lambda (x y) (> (car x) (car y)) ) ))
               (setq va (car flst))
            )
         )
      )
   (progn
         (setq lst (vl-remove-if-not '(lambda (x) (= (caddr x) nmin)) lst) )
         (setq lst (vl-sort lst '(lambda (x y) (> (car x) (car y)) ) ) )
         (setq va (car lst))
      )
   )
   va
)

(defun fdiv (pt LA LB a b)
(if (or (< (min LA LB) b) (< (max LA LB) a) (< (* LA LB) (* a b)))
      nil
   (if (>= LA LB)
         (cond
            ((< b LB (min a (* 2 b))) (drawmore pt (/ LA a) (/ LB b) a b))
            ((and (= (rem LA a) 0)(> (rem LA b) 0)(= (rem LB b) 0)(> (rem LB a) 0)) (drawmore pt (/ LA a) (/ LB b) a b))
            ((and (= (rem LA b) 0)(> (rem LA a) 0)(= (rem LB a) 0)(> (rem LB b) 0)) (drawmore pt (/ LA b) (/ LB a) b a))
            ((and (= (rem LA a) 0)(> (rem LA b) 0)(> (rem LB b) 0)(= (rem LB a) 0))
                  (progn
                     (setq dbat (ff LB b a t) cbat (ff LA b a t) dabt (ff LB a b t) )
                     (setq s1 (+ (* (/ LA a) (car dbat)) (* (cadr dbat) (car cbat)) (*
                                             (cadr cbat) (/ (- LB (* b (car dbat)))
b) )))
                     (setq s2 (+ (* (/ LB a) (car cbat)) (* (cadr cbat) (car dbat)) (* (cadr dbat) (/ (- LA (* b (car cbat)))
b) )))
                     (if (>= s1 s2)
                           (progn
                                 (setq ppt pt)
                                 (drawmore ppt (/ LA a) (car dbat) a b)
                                 (setq ppt (polar pt (/ pi 2) (* b (car dbat))))
                                 (drawmore ppt (car cbat) (cadr dbat) b a)
                                 (setq ppt (polar ppt 0 (* b (car cbat))))
                                 (drawmore ppt (cadr cbat) (/ (* a (cadr dbat)) b) a b)
                           )
                           (progn
                                 (setq ppt pt)
                                 (drawmore ppt (car cbat) (/ LB a)  b a)
                                 (setq ppt (polar ppt 0 (* b (car cbat))))
                                 (drawmore ppt (cadr cbat) (car dbat)  a b)
                                 (setq ppt (polar ppt (/ pi 2) (* b (car dbat))))
                                 (drawmore ppt (cadr dbat) (/ (* a (cadr cbat)) b) b a)
                           )
                     )
                  )
            )
            ((and (= (rem LA b) 0)(> (rem LA a) 0)(> (rem LB a) 0)(= (rem LB b) 0))
                  (progn
                     (setq dabt (ff LB a b t) cabt (ff LA a b t)  )
                     (setq s1 (+ (* (/ LA b) (car dabt)) (* (cadr dabt) (car cabt)) (* (cadr cabt) (/ (- LB (* a (car dabt)))
a) )))
                     (setq s2 (+ (* (/ LB b) (car cabt)) (* (cadr cabt) (car dabt)) (* (cadr dabt) (/ (- LA (* a (car cabt)))
a) )))
                     (if (>= s1 s2)
                           (progn
                                 (setq ppt pt)
                                 (drawmore ppt (/ LA b) (car dabt) b a)
                                 (setq ppt (polar pt (/ pi 2) (* a (car dabt))))
                                 (drawmore ppt (car cabt) (cadr dabt) a b )
                                 (setq ppt (polar ppt 0 (* a (car cabt))))
                                 (drawmore ppt (cadr cabt) (/ (* b (cadr dabt)) a) b a)
                           )
                           (progn
                                 (setq ppt pt)
                                 (drawmore ppt (car cabt) (/ LB b) a b )
                                 (setq ppt (polar ppt 0 (* a (car cabt))))
                                 (drawmore ppt (cadr cabt) (car dabt) b a )
                                 (setq ppt (polar ppt (/ pi 2) (* a (car dabt))))
                                 (drawmore ppt (cadr dabt) (/ (* b (cadr cabt)) a) a b)
                           )
                     )
                  )
            )
            ((and (= (rem LA b) 0)(> (rem LA a) 0)(> (rem LB a) 0)(> (rem LB b) 0))
                  (progn
                     (setq dabt (ff LB a b t) cabt (ff LA a b t))
                     (setq ppt pt)
                     (drawmore ppt (/ LA b) (car dabt) b a)
                     (setq ppt (polar pt (/ pi 2) (* a (car dabt))))
                     (drawmore ppt (car cabt) (cadr dabt) a b )
                     (setq ppt (polar ppt 0 (* a (car cabt))))
                     (drawmore ppt (cadr cabt) (/ (* b (cadr dabt)) a) b a)
                  )
            )
            ((and (> (rem LA b) 0)(> (rem LA a) 0)(> (rem LB a) 0)(= (rem LB b) 0))
                  (progn
                     (setq dabt (ff LB a b t) cabt (ff LA a b t))
                     (setq ppt pt)
                     (drawmore ppt  (car cabt)(/ LB b) a b)
                     (setq ppt (polar ppt 0 (* a (car cabt))))
                     (drawmore ppt (cadr cabt) (car dabt) b a)
                     (setq ppt (polar ppt (/ pi 2) (* a (car dabt))))
                     (drawmore ppt  (/ (* b (cadr cabt)) a) (cadr dabt) a b)
                  )
            )
            ((and (> (rem LA b) 0)(= (rem LA a) 0)(> (rem LB a) 0)(> (rem LB b) 0))
                  (progn
                     (setq dbat (ff LB b a t) cbat (ff LA b a t))
                     (setq ppt pt)
                     (drawmore ppt (/ LA a) (car dbat) a b )
                     (setq ppt (polar pt (/ pi 2) (* b (car dbat))))
                     (drawmore ppt (car cbat) (cadr dbat) b a)
                     (setq ppt (polar ppt 0 (* b (car cbat))))
                     (drawmore ppt (cadr cbat) (/ (* a (cadr dbat)) b)  a b)
                  )
            )
         ((and (> (rem LA b) 0)(> (rem LA a) 0)(> (rem LB a) 0)(> (rem LB b) 0))
               (progn
                     (setq dabt (ff LB a b t) dLA (- LA (* b (car dabt)) (* a (cadr dabt))))
                     (clfun pt (car dabt) (cadr dabt) a b (list 0 nil))
                     (fdiv (polar pt 0 (+ (* b (car dabt)) (* a (cadr dabt)))) dLA LB a b)
                                    )
            )
         )
         (cond
            ((< b LA (min a (* 2 b))) (drawmore pt (/ LA b) (/ LB a) b a))
            ((and (= (rem LA a) 0)(> (rem LA b) 0)(= (rem LB b) 0)(> (rem LB a) 0)) (drawmore pt (/ LA a) (/ LB b) a b))
            ((and (= (rem LA b) 0)(> (rem LA a) 0)(= (rem LB a) 0)(> (rem LB b) 0)) (drawmore pt (/ LA b) (/ LB a) b a))
            ((and (= (rem LA a) 0)(> (rem LA b) 0)(> (rem LB b) 0)(= (rem LB a) 0))
                  (progn
                     (setq dbat (ff LB b a t) cbat (ff LA b a t)  )
                     (setq s1 (+ (* (/ LA a) (car dbat)) (* (cadr dbat) (car cbat)) (* (cadr cbat) (/ (- LB (* b (car dbat)))
b) )))
                     (setq s2 (+ (* (/ LB a) (car cbat)) (* (cadr cbat) (car dbat)) (* (cadr dbat) (/ (- LA (* b (car cbat)))
b) )))
                     (if (>= s1 s2)
                           (progn
                                 (setq ppt pt)
                                 (drawmore ppt (/ LA a) (car dbat) a b)
                                 (setq ppt (polar pt (/ pi 2) (* b (car dbat))))
                                 (drawmore ppt (car cbat) (cadr dbat) b a)
                                 (setq ppt (polar ppt 0 (* b (car cbat))))
                                 (drawmore ppt (cadr cbat) (/ (* a (cadr dbat)) b) a b)
                           )
                           (progn
                                 (setq ppt pt)
                                 (drawmore ppt (car cbat) (/ LB a)  b a)
                                 (setq ppt (polar ppt 0 (* b (car cbat))))
                                 (drawmore ppt (cadr cbat) (car dbat)  a b)
                                 (setq ppt (polar ppt (/ pi 2) (* b (car dbat))))
                                 (drawmore ppt  (/ (* a (cadr cbat)) b) (cadr dbat) b a)
                           )
                     )
                  )
            )

            ((and (= (rem LA b) 0)(> (rem LA a) 0)(> (rem LB a) 0)(= (rem LB b) 0))
                  (progn
                     (setq dabt (ff LB a b t) cabt (ff LA a b t)  )
                     (setq s1 (+ (* (/ LA b) (car dabt)) (* (cadr dabt) (car cabt)) (* (cadr cabt) (/ (- LB (* a (car dabt)))
a) )))
                     (setq s2 (+ (* (/ LB b) (car cabt)) (* (cadr cabt) (car dabt)) (* (cadr dabt) (/ (- LA (* a (car cabt)))
a) )))
                     (if (>= s1 s2)
                           (progn
                                 (setq ppt pt)
                                 (drawmore ppt (/ LA b) (car dabt) b a)
                                 (setq ppt (polar pt (/ pi 2) (* a (car dabt))))
                                 (drawmore ppt (car cabt) (cadr dabt) a b )
                                 (setq ppt (polar ppt 0 (* a (car cabt))))
                                 (drawmore ppt (cadr cabt) (/ (* b (cadr dabt)) a) b a)
                           )
                           (progn
                                 (setq ppt pt)
                                 (drawmore ppt (car cabt) (/ LB b) a b )
                                 (setq ppt (polar ppt 0 (* a (car cabt))))
                                 (drawmore ppt (cadr cabt) (car dabt) b a )
                                 (setq ppt (polar ppt (/ pi 2) (* a (car dabt))))
                                 (drawmore ppt (/ (* b (cadr cabt)) a) (cadr dabt) a b)
                           )
                     )
                  )
            )
            ((and (= (rem LA b) 0)(> (rem LA a) 0)(> (rem LB a) 0)(> (rem LB b) 0))
                  (progn
                     (setq dabt (ff LB a b t) cabt (ff LA a b t))
                     (setq ppt pt)
                     (drawmore ppt (/ LA b) (car dabt) b a)
                     (setq ppt (polar pt (/ pi 2) (* a (car dabt))))
                     (drawmore ppt (car cabt) (cadr dabt) a b )
                     (setq ppt (polar ppt 0 (* a (car cabt))))
                     (drawmore ppt (cadr cabt) (/ (* b (cadr dabt)) a) b a)
                  )
            )
            ((and (> (rem LA b) 0)(> (rem LA a) 0)(> (rem LB a) 0)(= (rem LB b) 0))
                  (progn
                     (setq dabt (ff LB a b t) cabt (ff LA a b t))
                     (setq ppt pt)
                     (drawmore ppt  (car cabt)(/ LB b) a b)
                     (setq ppt (polar ppt 0 (* a (car cabt))))
                     (drawmore ppt (cadr cabt) (car dabt) b a)
                     (setq ppt (polar ppt (/ pi 2) (* a (car dabt))))
                     (drawmore ppt  (/ (* b (cadr cabt)) a) (cadr dabt) a b)
                  )
            )
            ((and (> (rem LA b) 0)(= (rem LA a) 0)(> (rem LB a) 0)(> (rem LB b) 0))
                  (progn
                     (setq dbat (ff LB b a t) cbat (ff LA b a t))
                     (setq ppt pt)
                     (drawmore ppt (/ LA a) (car dbat) a b )
                     (setq ppt (polar pt (/ pi 2) (* b (car dbat))))
                     (drawmore ppt (car cbat) (cadr dbat) b a)
                     (setq ppt (polar ppt 0 (* b (car cbat))))
                     (drawmore ppt (cadr cbat) (/ (* a (cadr dbat)) b)  a b)
                  )
            )
         ((and (> (rem LA b) 0)(> (rem LA a) 0)(> (rem LB a) 0)(> (rem LB b) 0))
               (progn
                     (setq cabt (ff LA a b t) dLB (- LB (* b (car cabt)) (* a (cadr cabt))))
                     (clfun pt (cadr cabt) (car cabt) a b (list 0 nil))
                     (fdiv (polar pt (/ pi 2) (+ (* b (car cabt)) (* a (cadr cabt)))) LA dLB a b)
                                    )
            )
         )
      )
   )
)
   (setq pt (getpoint "\n插入点位置："))
   (setq nn (getint "母材长边长度\nn=：")
         mm (getint "母材短边长度\nm=：")
         aa (getint "构件长边长度\na=：")
         bb (getint "构件短边长度\na=：")
   )
   (drawone pt nn mm)
   (setq ppt pt cabt nil dabt nil)
   (setq vc (frem nn aa bb))
   (setq vd (frem mm aa bb))
   (drawmore ppt (/ (* (car vc) (cadr vc)) aa)  (/ (* (car vd) (cadr vd)) bb)  aa bb)
   (setq ppt (polar pt 0 (* (car vc) (cadr vc))))
   (setq cabt (ff (caddr vc) aa bb nil))
   (drawmore ppt (car cabt) (/ (* (car vd) (cadr vd)) bb)  aa bb)
   (setq ppt (polar ppt 0 (* (car cabt) aa)))
   (drawmore ppt (cadr cabt) (/ (* (car vd) (cadr vd)) aa)  bb aa)
   (setq dabt (ff (caddr vd) aa bb nil))
   (setq ppt (polar pt (/ pi 2) (* (car vd) (cadr vd))))
   (drawmore ppt (/ (* (car vc) (cadr vc)) bb) (car dabt) bb aa )
   (setq ppt (polar ppt (/ pi 2) (* (car dabt) aa)))
   (drawmore ppt (/ (* (car vc) (cadr vc)) aa) (cadr dabt) aa bb)
   (setq ppt (list (+ (car pt) (* (car vc) (cadr vc))) (+ (cadr pt) (* (car vd) (cadr vd))  ) ))
   (fdiv ppt (caddr vc) (caddr vd) aa bb)
)

aimisiyou · 发表于 2017-12-17 12:29:45

本帖最后由 aimisiyou 于 2017-12-18 09:55 编辑

没有经过证明的定性思维真的会欺骗你！！！前面86#的数据（124 104 10 7）真是有缘啊，冥冥中注定给我一个惊喜，今天验算时意外发现了以前错误的定性思维，即整体最优=局部最优+剩余部分最优！！！如图1，以前的思路是尽量把水平方向和竖直方向排紧凑，剩余右上角一个小矩形，然后递归运算。图2很好的否定了这一思维，同时也确定了矩形124*104中最多可以裁出184个10*7的小矩形，而不是以前坚信不疑的183个。有下料软件的朋友可以检验下，若得出的是183，那么你该重新审视你的软件了。

aimisiyou · 发表于 2017-12-18 12:27:15

本帖最后由 aimisiyou 于 2017-12-18 13:00 编辑

上面的方法（简称十字法）已经证实有误，那么如下图的环绕法能否得到最优解呢？最主要的是怎么证明一种算法对运算结果是没有问题的，而不是仅仅凭着感觉认为该算法是对的？如果环绕法也不行，那岂不“无从下手”了（因为从任何一个局部开始都会出错）？

aimisiyou · 发表于 2017-12-18 22:39:03

环绕法也出现反例。如图（54，34，10， 7），上面用环绕法仅得到24个小矩形，但实际最多可以得到25个小矩形。

aimisiyou · 发表于 2017-12-18 23:23:29

本帖最后由 aimisiyou 于 2017-12-18 23:33 编辑

按照图中算法写如下递推函数
(defun fnum (LA LB aa bb)
  (if (or (< (min LA LB) bb) (< (max LA LB) aa) (< (* LA LB) (* aa bb)))
   (setq va 0)
   (setq va (max
               (+ (/ LA bb) (fnum LA (- LB aa) aa bb))
               (+ (/ LB bb) (fnum (- LA aa) LB aa bb))
            )
)
  )
)
FNUM
_$ (fnum 54 34 10 7)
24
可见这个算法是有问题的！！！

账号		自动登录	找回密码
密码			立即注册

[原创] 二维下料