采用连分数法求解单一规格矩形直切下料问题

aimisiyou

_$ (defun LF (c d)   ;;;c>d，且c、d互质
  (setq lst nil)
  (if (= (rem c d) 0)
      (setq lst (list (/ c d)))
      (setq lst (cons (/ c d) (LF d (rem c d))))
   )
)
LF
_$ (LF 10 7)
(1 2 3)
_$ (LF 67 37)
(1 1 4 3 2)
_$

aimisiyou

_$ (defun HF (lst)
   (if (= (length lst) 2)
       (setq va (list (+ 1 (* (car lst)(cadr lst))) (cadr lst)))
           (setq va (list (+ (cadr (HF (cdr lst))) (* (car lst)(car (HF (cdr lst))))) (car (HF (cdr lst)))))
  )
)
HF
_$  (HF (LF 67 37))
(67 37)
_$ (HF '(1 1 4 3 2))
(67 37)
_$ (HF '(1 1 4 3 1))
(38 21)
_$ (HF '(1 1 4 3))
(29 16)
_$ (HF '(1 1 1 5))
(17 11)
_$ (HF '(1 1 1 4))
(14 9)
_$ (HF '(1 1 1))
(3 2)
_$

aimisiyou

第一步，我们求出c''/d''<c/d<c'/d'，其中c'',c'<c；d'',d'<d。
如（7,5）<(10 ,7)<(3,2),
   (3,2)<(17,11)<(14,9).
假设(LF c d)=(x_1,x_2,x_3，……x_(n-1)，x_n)
当n为奇数时，c''/d''=(HF '(x_1,x_2,x_3……，x_(n-1),x_n -1))<c/d<c'/d'=(HF '(x_1,x_2,x_3……，x_(n-1)));
当n为偶数时，c''/d''=(HF '(x_1,x_2,x_3……，x_(n-1)))<c/d<c'/d'=(HF '(x_1,x_2,x_3……，x_(n-1),x_n -1)).如

_$ (LF 49 31)
(1 1 1 2 1 1 2)    n=7
_$ (HF '(1 1 1 2 1 1 1))
(30 19)
_$ (HF '(1 1 1 2 1 1))
(19 12)
_$

故(30 19)<(49 31)<(19 12)

aimisiyou

_$ (defun xl (LA LB c d)
(defun LF (c d)   ;;;c>d
  (setq lst nil)
  (if (= (rem c d) 0)
      (setq lst (list (/ c d)))
      (setq lst (cons (/ c d) (LF d (rem c d))))
   )
)
(defun HF (lst)
   (if (<= (length lst) 2)
       (if (= (length lst) 2)
           (setq va (list (+ 1 (* (car lst)(cadr lst))) (cadr lst)))
                   (setq va (list (car lst) 1))
                )
           (setq va (list (+ (cadr (HF (cdr lst))) (* (car lst)(car (HF (cdr lst))))) (car (HF (cdr lst)))))
  )
)
(defun FCC(k1 k2 c d)
  (if (= d 1)
      (setq num_cc (* k1 k2 c))
          (progn
        (if (= (rem (length (LF c d)) 2) 0)
                (setq cd (HF (reverse (cdr (reverse (LF c d))))))
                (setq cd (HF (reverse (cons (- (last (LF c d)) 1) (cdr (reverse (LF c d)))))))
         )
        (setq r2 (rem k1 (cadr cd)))
        (setq t2 (rem k2 (cadr cd)))
        (setq num_cc (+ (* (/ k1 (cadr cd)) k2 (car cd))  (* (/ k2 (cadr cd)) r2 (car cd))  (FCC r2 t2 (car cd) (cadr cd))))
                )
    )
)
(defun FDD (k1 k2 c d)
  (if (= d 1)
      (setq num_cc (max (+ (* k2 (/ k1 c)) (* (rem k1 c) (/ k2 c)))
                            (+ (* k1 (/ k2 c)) (* (rem k2 c) (/ k1 c)))
                                        )
           )
          (progn
        (if (= (rem (length (LF c d)) 2) 0)
                (setq cd (HF (reverse (cons (- (last (LF c d)) 1) (cdr (reverse (LF c d)))))))
                (setq cd (HF (reverse (cdr (reverse (LF c d))))))
         )
        (setq r1 (rem k1 (car cd)))
        (setq t1 (rem k2 (car cd)))
        (setq num_cc (+ (* (/ k1 (car cd)) k2 (cadr cd))  (* (/ k2 (car cd)) r1 (cadr cd))  (FDD r1 t1 (car cd) (cadr cd))))
                )
    )
)
(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
)
(setq na (/ LA (* c d)))
(setq lsta (ff (rem LA (* c d)) c d nil))
(setq nb (/ LB (* c d)))
(setq lstb (ff (rem LB (* c d)) c d nil))
(setq num (+ (* na nb c d)
             (* (car lsta) nb c)
                         (* (cadr lsta) nb d)
                         (* (car lstb) na c)
                         (* (cadr lstb) na d)                        
                         (* (car lsta) (cadr lstb))                        
                         (* (cadr lsta) (car lstb))
                         (FCC (car lsta) (car lstb) c d)
                         (FDD (cadr lsta) (cadr lstb) c d)
                   )
)
)
XL
_$ (xl 131 75 19 9)
54
_$ (xl 200 100 19 9)
116
_$ (xl 200 100 10 7)
285
_$ (xl 124 104 10 7)
182
_$ (xl 17 17 10 7)
3
_$

aimisiyou

按图片中的上界估算函数U（x,y）计算效率更高些。
如（LA，Lb，c ，d）=（17，17 ，10 ，7）
按U（x，y）算法计算，得
a=17-int((17-10)/7)*7=10
b=17-int(17/7)*7=3
c=17-int(17/10)*10=7
d=17-int(17/10)*10=7
n=int((17*17-10*3-7*7)/(10*7))=3

aimisiyou

_$ (xl 106 106 15 7)
105
_$ (FCC 1 1 15 7)
2
_$ (FDD 13 13 15 7)
78
_$
2+78+13+13=106>105
问题出在（rem LA (* c d)）不能线性分解成k1*c+k2*d形式,故此时不能按截取最小公倍数去算。即当（last （ff (rem LA (* cd))  c d nil））/=0时，应按LA=（K-1）cd+(cd+ret)去算，对(cd+ret)进行线性分解成k1*c+k2*d.

aimisiyou

_$ (defun xl (LA LB c d)
(defun LF (c d)   ;;;c>d
  (setq lst nil)
  (if (= (rem c d) 0)
      (setq lst (list (/ c d)))
      (setq lst (cons (/ c d) (LF d (rem c d))))
   )
)
(defun HF (lst)
   (if (<= (length lst) 2)
       (if (= (length lst) 2)
           (setq va (list (+ 1 (* (car lst)(cadr lst))) (cadr lst)))
                   (setq va (list (car lst) 1))
                )
           (setq va (list (+ (cadr (HF (cdr lst))) (* (car lst)(car (HF (cdr lst))))) (car (HF (cdr lst)))))
  )
)
(defun FCC(k1 k2 c d)
  (if (= d 1)
      (setq num_cc (* k1 k2 c))
          (progn
        (if (= (rem (length (LF c d)) 2) 0)
                (setq cd (HF (reverse (cdr (reverse (LF c d))))))
                (setq cd (HF (reverse (cons (- (last (LF c d)) 1) (cdr (reverse (LF c d)))))))
         )
        (setq r2 (rem k1 (cadr cd)))
        (setq t2 (rem k2 (cadr cd)))
        (setq num_cc (+ (* (/ k1 (cadr cd)) k2 (car cd))  (* (/ k2 (cadr cd)) r2 (car cd))  (FCC r2 t2 (car cd) (cadr cd))))
                )
    )
)
(defun FDD (k1 k2 c d)
  (if (= d 1)
      (setq num_cc (max (+ (* k2 (/ k1 c)) (* (rem k1 c) (/ k2 c)))
                            (+ (* k1 (/ k2 c)) (* (rem k2 c) (/ k1 c)))
                                        )
           )
          (progn
        (if (= (rem (length (LF c d)) 2) 0)
                (setq cd (HF (reverse (cons (- (last (LF c d)) 1) (cdr (reverse (LF c d)))))))
                (setq cd (HF (reverse (cdr (reverse (LF c d))))))
         )
        (setq r1 (rem k1 (car cd)))
        (setq t1 (rem k2 (car cd)))
        (setq num_cc (+ (* (/ k1 (car cd)) k2 (cadr cd))  (* (/ k2 (car cd)) r1 (cadr cd))  (FDD r1 t1 (car cd) (cadr cd))))
                )
    )
)
(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
)
(if (/= (last (ff (rem LA (* c d)) c d nil)) 0)
    (progn
      (setq na (- (/ LA (* c d)) 1))
      (setq lsta (ff (+ (* c d)(rem LA (* c d))) c d nil))
         )
    (progn
       (setq na (/ LA (* c d)))
       (setq lsta (ff (rem LA (* c d)) c d nil))
         )
)
(if (/= (last (ff (rem LB (* c d)) c d nil)) 0)
    (progn
      (setq nb (- (/ LB (* c d)) 1))
      (setq lstb (ff (+ (* c d)(rem LB (* c d))) c d nil))
         )
    (progn
       (setq nb (/ LB (* c d)))
       (setq lstb (ff (rem LB (* c d)) c d nil))
         )
)
(setq num (+ (* na nb c d)
             (* (car lsta) nb c)
                         (* (cadr lsta) nb d)
                         (* (car lstb) na c)
                         (* (cadr lstb) na d)                        
                         (* (car lsta) (cadr lstb))                        
                         (* (cadr lsta) (car lstb))
                         (FCC (car lsta) (car lstb) c d)
                         (FDD (cadr lsta) (cadr lstb) c d)
                   )
)
)
XL
_$ (xl 86 86 10 7)
102
_$ (xl 74 76 10 7)
78
_$

aimisiyou

接下来采用分支定界法，若截取下来的一个条带上的毛坯数+余下矩形的最大毛坯数<原矩形最大毛坯数，则删除该分支。留下的都是与原矩形最大毛坯数相等的情形，然后选择其中条代数最少得即为最优切割方式。

aimisiyou

_$ (defun drawfun (LA LB c d)
  (if (or (< (min LA LB) d) (< (max LA LB) c))
      (setq valst (list nil))
      (setq valst (append
                           (if (= (+ (/ LB d) (xl (- LA c) LB c d)) (xl LA LB c d))
                                               (mapcar '(lambda (x) (cons (list 0 1) x)) (drawfun (- LA c) LB c d))
                                            )
                           (if (= (+ (/ LA c) (xl LA  (- LB d) c d)) (xl LA LB c d))
                                               (mapcar '(lambda (x) (cons (list 0 0) x)) (drawfun LA (- LB d) c d))
                                            )
                           (if (= (+ (/ LB c) (xl (- LA d) LB c d)) (xl LA LB c d))
                                               (mapcar '(lambda (x) (cons (list 1 1) x)) (drawfun (- LA d) LB c d ))
                                            )
                           (if (= (+ (/ LA d) (xl LA  (- LB c) c d)) (xl LA LB c d))
                                               (mapcar '(lambda (x) (cons (list 1 0) x)) (drawfun LA (- LB c) c d ))
                                            )
                                   )
           )  
        )
)
DRAWFUN
_$ (drawfun 17 17 10 7)
(((0 1) (0 0) (1 1)) ((0 1) (0 0) (1 0)) ((0 1) (1 1)) ((0 1) (1 0)) ((0 0) (0 1) (1 1)) ((0 0) (0 1) (1 0)) ((0 0) (1 1) (0 1)) ((0 0) (1 1) (0 0)) ((0 0) (1 1) (1 1)) ((0 0) (1 1) (1 0)) ((0 0) (1 0)) ((1 1) (0 1)) ((1 1) (0 0) (0 1)) ((1 1) (0 0) (0 0)) ((1 1) (0 0) (1 1)) ((1 1) (0 0) (1 0)) ((1 1) (1 0) (0 1)) ((1 1) (1 0) (0 0)) ((1 0) (0 1)) ((1 0) (0 0)) ((1 0) (1 1) (0 1)) ((1 0) (1 1) (0 0)))
_$ (length (drawfun 17 17 10 7))
22
_$
_$ (length (drawfun 34 34 10 7))
980
_$ _$  (drawfun 29 23 10 7)
(((1 1) (0 0) (0 0) (0 0)) ((1 1) (0 0) (0 0) (1 0)) ((1 1) (0 0) (1 0)) ((1 1) (1 1) (1 1) (1 1)) ((1 1) (1 1) (1 1) (1 0) (1 1)) ((1 1) (1 1) (1 1) (1 0) (1 0)) ((1 1) (1 1) (1 0) (1 1) (1 1)) ((1 1) (1 1) (1 0) (1 1) (1 0)) ((1 1) (1 1) (1 0) (1 0)) ((1 1) (1 0) (0 0)) ((1 1) (1 0) (1 1) (1 1) (1 1)) ((1 1) (1 0) (1 1) (1 1) (1 0)) ((1 1) (1 0) (1 1) (1 0)) ((1 1) (1 0) (1 0)) ((1 0) (1 1) (0 0)) ((1 0) (1 1) (1 1) (1 1) (1 1)) ((1 0) (1 1) (1 1) (1 1) (1 0)) ((1 0) (1 1) (1 1) (1 0)) ((1 0) (1 1) (1 0)) ((1 0) (1 0)))
_$
可见（drawfun 29 23 10 7）结果中最少得条带是 ((1 0) (1 0))，注意是由后往前，故作图应按照（reverse   ((1 0) (1 0))）,如图，先截取黄色条带，再截取蓝色条带，裁剪方式最优。
虽然理论上可行（数据较小可运行），但数据一大就无法运行。

aimisiyou

(defun c:zqxl ()
(defun xl (LA LB c d)
(defun LF (c d)   ;;;c>d
  (setq lst nil)
  (if (= (rem c d) 0)
      (setq lst (list (/ c d)))
      (setq lst (cons (/ c d) (LF d (rem c d))))
   )
)
(defun HF (lst)
   (if (<= (length lst) 2)
       (if (= (length lst) 2)
           (setq va (list (+ 1 (* (car lst)(cadr lst))) (cadr lst)))
                   (setq va (list (car lst) 1))
                )
           (setq va (list (+ (cadr (HF (cdr lst))) (* (car lst)(car (HF (cdr lst))))) (car (HF (cdr lst)))))
  )
)
(defun FCC(k1 k2 c d)
  (if (= d 1)
      (setq num_cc (* k1 k2 c))
          (progn
        (if (= (rem (length (LF c d)) 2) 0)
                (setq cd (HF (reverse (cdr (reverse (LF c d))))))
                (setq cd (HF (reverse (cons (- (last (LF c d)) 1) (cdr (reverse (LF c d)))))))
         )
        (setq r2 (rem k1 (cadr cd)))
        (setq t2 (rem k2 (cadr cd)))
        (setq num_cc (+ (* (/ k1 (cadr cd)) k2 (car cd))  (* (/ k2 (cadr cd)) r2 (car cd))  (FCC r2 t2 (car cd) (cadr cd))))
                )
    )
)
(defun FDD (k1 k2 c d)
  (if (= d 1)
      (setq num_cc (max (+ (* k2 (/ k1 c)) (* (rem k1 c) (/ k2 c)))
                            (+ (* k1 (/ k2 c)) (* (rem k2 c) (/ k1 c)))
                                        )
           )
          (progn
        (if (= (rem (length (LF c d)) 2) 0)
                (setq cd (HF (reverse (cons (- (last (LF c d)) 1) (cdr (reverse (LF c d)))))))
                (setq cd (HF (reverse (cdr (reverse (LF c d))))))
         )
        (setq r1 (rem k1 (car cd)))
        (setq t1 (rem k2 (car cd)))
        (setq num_cc (+ (* (/ k1 (car cd)) k2 (cadr cd))  (* (/ k2 (car cd)) r1 (cadr cd))  (FDD r1 t1 (car cd) (cadr cd))))
                )
    )
)
(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
)
(if (or (< (min LA LB) d) (< (max LA LB) c))
    (setq num 0)
        (if (or (= (rem LA c) (rem LB d) 0) (= (rem LA d) (rem LB c) 0))
         (setq num (/ (* LA LB) c d))
         (progn
(if (and (> LA (* c d))  (/= (last (ff (rem LA (* c d)) c d nil)) 0))
    (progn
      (setq na (- (/ LA (* c d)) 1))
      (setq lsta (ff (+ (* c d)(rem LA (* c d))) c d nil))
         )
    (progn
       (setq na (/ LA (* c d)))
       (setq lsta (ff (rem LA (* c d)) c d nil))
         )
)
(if (and (> LB (* c d)) (/= (last (ff (rem LB (* c d)) c d nil)) 0))
    (progn
      (setq nb (- (/ LB (* c d)) 1))
      (setq lstb (ff (+ (* c d)(rem LB (* c d))) c d nil))
         )
    (progn
       (setq nb (/ LB (* c d)))
       (setq lstb (ff (rem LB (* c d)) c d nil))
         )
)
)
)
)
(setq num (+ (* na nb c d)
             (* (car lsta) nb c)
                         (* (cadr lsta) nb d)
                         (* (car lstb) na c)
                         (* (cadr lstb) na d)                        
                         (* (car lsta) (cadr lstb))                        
                         (* (cadr lsta) (car lstb))
                         (FCC (car lsta) (car lstb) c d)
                         (FDD (cadr lsta) (cadr lstb) c d)
                   )
)
)
(defun px (LA LB c d)
  (if (or (< (min LA LB) d) (< (max LA LB) c))
      (setq valst (list nil))
      (setq valst (append
                           (if (= (+ (/ LB d) (xl (- LA c) LB c d)) (xl LA LB c d))
                                               (mapcar '(lambda (x) (cons (list 0 1) x)) (px (- LA c) LB c d))
                                               (mapcar '(lambda (x) (cons (list 1 0) x)) (px LA (- LB c) c d))                                       
                            )
                           (if (= (+ (/ LA c) (xl LA  (- LB d) c d)) (xl LA LB c d))
                                               (mapcar '(lambda (x) (cons (list 0 0) x)) (px LA (- LB d) c d))
                                               (mapcar '(lambda (x) (cons (list 1 1) x)) (px (- LA d) LB c d))
                                            )
                           (if (= (+ (/ LB c) (xl (- LA d) LB c d)) (xl LA LB c d))
                                               (mapcar '(lambda (x) (cons (list 1 1) x)) (px (- LA d) LB c d ))
                                               (mapcar '(lambda (x) (cons (list 0 0) x)) (px LA  (- LB d) c d ))
                                            )
                           (if (= (+ (/ LA d) (xl LA  (- LB c) c d)) (xl LA LB c d))
                                               (mapcar '(lambda (x) (cons (list 1 0) x)) (px LA (- LB c) c d ))
                                               (mapcar '(lambda (x) (cons (list 0 1) x)) (px (- LA c) LB c d ))
                                            )
                                   )
           )  
        )
)
(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 drawfun (pt LA LB c d lst)
  (if lst
     (cond
            ((equal (car lst) '(0 1))
                  (progn
                     (drawmore pt 1 (/ LB d) c d)
             (drawfun (polar pt 0 c) (- LA c) LB c d (cdr lst))
                   )
                 )
            ((equal (car lst) '(0 0))
                  (progn
                     (drawmore pt (/ LA c) 1 c d)
             (drawfun (polar pt (/ pi 2) d) LA (- LB d) c d (cdr lst))
                   )
                 )  
            ((equal (car lst) '(1 1))
                  (progn
                     (drawmore pt 1 (/ LB c) d c)
             (drawfun (polar pt 0 d) (- LA d) LB c d (cdr lst))
                   )
                 )
            ((equal (car lst) '(1 0))
                  (progn
                     (drawmore pt (/ LA d) 1 d c)
             (drawfun (polar pt (/ pi 2) c) LA (- LB c) c d (cdr lst))
                   )
                 )  
    )
  )
)
(setq pt (getpoint "\n插入点位置："))
(setq LA (getint "母材长边长度\nLA=：")
      LB (getint "母材短边长度\nLB=：")
      c (getint "构件长边长度\nc=：")
      d (getint "构件短边长度\nd=：")
)
(entmake
        (list
                '(0 . "LWPOLYLINE")                        
                '(100 . "AcDbEntity")
                '(100 . "AcDbPolyline")
                '(90 . 4)                                 
                '(70 . 1)                                 
                (cons 10 (list (car pt) (cadr pt)))
                (cons 10 (list (+ (car pt) LA) (cadr pt)))
                (cons 10 (list (+ (car pt) LA) (+ (cadr pt) LB)))
                (cons 10 (list (car pt) (+ (cadr pt) LB)))            
                (cons 210 '(0 0 1))   
          )                     
)
(setq lst (car (vl-sort (px LA LB c d) '(lambda (e1 e2) (< (length e1) (length e2))))))
(drawfun pt LA LB c d (reverse lst))
)

只运行了几个小数据，运行结果还算满意。数据一大（毛坯数超过50以上），就运行卡死。

20180318

XL
_$ (xl 131 75 19 9)
54
_$ (xl 200 100 19 9)
116
_$ (xl 200 100 10 7)
285
_$ (xl 124 104 10 7)
182
_$ (xl 17 17 10 7)
3
_$
這是LISP語法嗎?

aimisiyou

20180318 发表于 2019-9-5 08:49
XL
_$ (xl 131 75 19 9)
54

自定义函数。

aimisiyou

(defun xl (LA LB c d)
(defun LF (c d)   ;;;c>d
  (setq lst nil)
  (if (= (rem c d) 0)
      (setq lst (list (/ c d)))
      (setq lst (cons (/ c d) (LF d (rem c d))))
   )
)
(defun HF (lst)
   (if (<= (length lst) 2)
       (if (= (length lst) 2)
           (setq va (list (+ 1 (* (car lst)(cadr lst))) (cadr lst)))
                   (setq va (list (car lst) 1))
                )
           (setq va (list (+ (cadr (HF (cdr lst))) (* (car lst)(car (HF (cdr lst))))) (car (HF (cdr lst)))))
  )
)
(defun FCC(k1 k2 c d)
  (if (= d 1)
      (setq num_cc (* k1 k2 c))
          (progn
        (if (= (rem (length (LF c d)) 2) 0)
                (setq cd (HF (reverse (cdr (reverse (LF c d))))))
                (setq cd (HF (reverse (cons (- (last (LF c d)) 1) (cdr (reverse (LF c d)))))))
         )
        (setq r2 (rem k1 (cadr cd)))
        (setq t2 (rem k2 (cadr cd)))
        (setq num_cc (+ (* (/ k1 (cadr cd)) k2 (car cd))  (* (/ k2 (cadr cd)) r2 (car cd))  (FCC r2 t2 (car cd) (cadr cd))))
                )
    )
)
(defun FDD (k1 k2 c d)
  (if (= d 1)
      (setq num_cc (max (+ (* k2 (/ k1 c)) (* (rem k1 c) (/ k2 c)))
                            (+ (* k1 (/ k2 c)) (* (rem k2 c) (/ k1 c)))
                                        )
           )
          (progn
        (if (= (rem (length (LF c d)) 2) 0)
                (setq cd (HF (reverse (cons (- (last (LF c d)) 1) (cdr (reverse (LF c d)))))))
                (setq cd (HF (reverse (cdr (reverse (LF c d))))))
         )
        (setq r1 (rem k1 (car cd)))
        (setq t1 (rem k2 (car cd)))
        (setq num_cc (+ (* (/ k1 (car cd)) k2 (cadr cd))  (* (/ k2 (car cd)) r1 (cadr cd))  (FDD r1 t1 (car cd) (cadr cd))))
                )
    )
)
(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
)
(if (/= (last (ff (rem LA (* c d)) c d nil)) 0)
    (progn
      (setq na (- (/ LA (* c d)) 1))
      (setq lsta (ff (+ (* c d)(rem LA (* c d))) c d nil))
         )
    (progn
       (setq na (/ LA (* c d)))
       (setq lsta (ff (rem LA (* c d)) c d nil))
         )
)
(if (/= (last (ff (rem LB (* c d)) c d nil)) 0)
    (progn
      (setq nb (- (/ LB (* c d)) 1))
      (setq lstb (ff (+ (* c d)(rem LB (* c d))) c d nil))
         )
    (progn
       (setq nb (/ LB (* c d)))
       (setq lstb (ff (rem LB (* c d)) c d nil))
         )
)
(if (or (< (min LA LB) d) (< (max LA LB) c))
    (setq num 0)
        (setq num (+ (* na nb c d)
             (* (car lsta) nb c)
                         (* (cadr lsta) nb d)
                         (* (car lstb) na c)
                         (* (cadr lstb) na d)                        
                         (* (car lsta) (cadr lstb))                        
                         (* (cadr lsta) (car lstb))
                         (FCC (car lsta) (car lstb) c d)
                         (FDD (cadr lsta) (cadr lstb) c d)
                   )
       )
)
)
(defun jq(LA LB a b)
  (setq x LA)
  (setq flag t)
  (while (and flag (>= x 0))
     (setq y LB)
     (while (and flag (>= y 0))
     (if (= (xl LA LB a b)
            (max (+ (* (/ x a) (/ LB b)) (* (/ (- LA x) b) (/ (- LB y) a)) (xl (- LA x) y a b))
                 (+ (* (/ x a) (/ y b)) (* (/ LA b) (/ (- LB y) a)) (xl (- LA x) y a b))
                     )
              )
             (progn
                 (setq flag nil)
                 (if (>= (+ (* (/ x a) (/ LB b)) (* (/ (- LA x) b) (/ (- LB y) a)))
                     (+ (* (/ x a) (/ y b)) (* (/ LA b) (/ (- LB y) a)))
                  )
              (setq vat (list x y 1))
                  (setq vat (list x y 0))
                          )
              )
             (if flag (setq y (- y 1)))
           )
           )
             (if flag (setq x (- x 1)))
   )
   vat
)
_$ (jq 124 104 10 7)
(110 84 0)
_$ (jq 116 85 23 12)
(116 85 1)
_$

aimisiyou

;;;剪切下料的毛坯个数最多，且剪切刀数最少。
(defun c:tt()
(defun xl (LA LB c d)
(defun LF (c d)   ;;;c>d
  (setq lst nil)
  (if (= (rem c d) 0)
      (setq lst (list (/ c d)))
      (setq lst (cons (/ c d) (LF d (rem c d))))
   )
)
(defun HF (lst)
   (if (<= (length lst) 2)
       (if (= (length lst) 2)
           (setq va (list (+ 1 (* (car lst)(cadr lst))) (cadr lst)))
                   (setq va (list (car lst) 1))
                )
           (setq va (list (+ (cadr (HF (cdr lst))) (* (car lst)(car (HF (cdr lst))))) (car (HF (cdr lst)))))
  )
)
(defun FCC(k1 k2 c d)
  (if (= d 1)
      (setq num_cc (* k1 k2 c))
          (progn
        (if (= (rem (length (LF c d)) 2) 0)
                (setq cd (HF (reverse (cdr (reverse (LF c d))))))
                (setq cd (HF (reverse (cons (- (last (LF c d)) 1) (cdr (reverse (LF c d)))))))
         )
        (setq r2 (rem k1 (cadr cd)))
        (setq t2 (rem k2 (cadr cd)))
        (setq num_cc (+ (* (/ k1 (cadr cd)) k2 (car cd))  (* (/ k2 (cadr cd)) r2 (car cd))  (FCC r2 t2 (car cd) (cadr cd))))
                )
    )
)
(defun FDD (k1 k2 c d)
  (if (= d 1)
      (setq num_cc (max (+ (* k2 (/ k1 c)) (* (rem k1 c) (/ k2 c)))
                            (+ (* k1 (/ k2 c)) (* (rem k2 c) (/ k1 c)))
                                        )
           )
          (progn
        (if (= (rem (length (LF c d)) 2) 0)
                (setq cd (HF (reverse (cons (- (last (LF c d)) 1) (cdr (reverse (LF c d)))))))
                (setq cd (HF (reverse (cdr (reverse (LF c d))))))
         )
        (setq r1 (rem k1 (car cd)))
        (setq t1 (rem k2 (car cd)))
        (setq num_cc (+ (* (/ k1 (car cd)) k2 (cadr cd))  (* (/ k2 (car cd)) r1 (cadr cd))  (FDD r1 t1 (car cd) (cadr cd))))
                )
    )
)
(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
)
(if (/= (last (ff (rem LA (* c d)) c d nil)) 0)
   (if (> LA (* c d))
      (progn
        (setq na (- (/ LA (* c d)) 1))
        (setq lsta (ff (+ (* c d)(rem LA (* c d))) c d nil))
       )
      (progn
        (setq na 0)
        (setq lsta (ff LA c d nil))
       )
        )
   (progn
       (setq na (/ LA (* c d)))
       (setq lsta (ff (rem LA (* c d)) c d nil))
    )
)
(if (/= (last (ff (rem LB (* c d)) c d nil)) 0)
   (if (> LB (* c d))
       (progn
          (setq nb (- (/ LB (* c d)) 1))
          (setq lstb (ff (+ (* c d)(rem LB (* c d))) c d nil))
        )
       (progn
          (setq nb 0)
          (setq lstb (ff LB c d nil))
        )
        )
    (progn
       (setq nb (/ LB (* c d)))
       (setq lstb (ff (rem LB (* c d)) c d nil))
     )
)
(if (or (< (min LA LB) d) (< (max LA LB) c))
    (setq num 0)
    (setq num (+ (* na nb c d)
             (* (car lsta) nb c)
                         (* (cadr lsta) nb d)
                         (* (car lstb) na c)
                         (* (cadr lstb) na d)                        
                         (* (car lsta) (cadr lstb))                        
                         (* (cadr lsta) (car lstb))
                         (FCC (car lsta) (car lstb) c d)
                         (FDD (cadr lsta) (cadr lstb) c d)
                   )
       )
)
)
(defun jq(LA LB a b)
(if (= (rem LA b) (rem LB a) 0)
  (setq vat (list 0 0 0))
  (progn
   (setq x LA)
   (setq flag t)
   (while (and flag (>= x 0))
     (setq y LB)
     (while (and flag (>= y 0))
     (if (= (xl LA LB a b)
            (max (+ (* (/ x a) (/ LB b)) (* (/ (- LA x) b) (/ (- LB y) a)) (xl (- LA x) y a b))
                 (+ (* (/ x a) (/ y b)) (* (/ LA b) (/ (- LB y) a)) (xl (- LA x) y a b))
                     )
              )
             (progn
                 (setq flag nil)
                 (if (>= (+ (* (/ x a) (/ LB b)) (* (/ (- LA x) b) (/ (- LB y) a)))
                     (+ (* (/ x a) (/ y b)) (* (/ LA b) (/ (- LB y) a)))
                  )
              (setq vat (list x y 1))
                  (setq vat (list x y 0))
                          )
              )
             (if flag (setq y (- y 1)))
           )
           )
             (if flag (setq x (- x 1)))
     )
        )
   )
   vat
)

(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)
       )      
)
(setq pt (getpoint "\n插入点位置："))
(setq LA (getint "母材长边长度\nLA=：")
      LB (getint "母材短边长度\nLB=：")
      c (getint "构件长边长度\nc=：")
      d (getint "构件短边长度\nd=：")
)
(entmake
        (list
                '(0 . "LWPOLYLINE")                        
                '(100 . "AcDbEntity")
                '(100 . "AcDbPolyline")
                '(90 . 4)                                 
                '(70 . 1)                                 
                (cons 10 (list (car pt) (cadr pt)))
                (cons 10 (list (+ (car pt) LA) (cadr pt)))
                (cons 10 (list (+ (car pt) LA) (+ (cadr pt) LB)))
                (cons 10 (list (car pt) (+ (cadr pt) LB)))            
                (cons 210 '(0 0 1))   
          )                     
)
(while (and (>= (min LA LB) d) (>= (max LA LB) c))
     (setq xylst (jq LA LB c d))
         (if (= (caddr xylst) 0)
             (progn
           (drawmore pt (/ (car xylst) c)(/ (cadr xylst) d) c d)
                   (setq dis1 (rem LA d))
           (setq dis2 (rem (- LB (cadr xylst)) c))
           (drawmore (polar (polar pt (/ pi 2) (+ (cadr xylst) dis2)) 0 dis1) (/ LA d)(/ (- LB (cadr xylst)) c) d c)
                 )
             (progn
           (drawmore pt (/ (car xylst) c)(/ LB d) c d)
                   (setq dis1 (rem (- LA (car xylst)) d))
           (setq dis2 (rem (- LB (cadr xylst)) c))
           (drawmore (polar (polar pt (/ pi 2) (+ (cadr xylst) dis2)) 0 dis1) (/ (- LA (car xylst)) d)(/ (- LB (cadr xylst)) c) d c)
                 )
           )
           (setq LA (- LA (car xylst)))
           (setq LB  (cadr xylst))
           (setq pt (polar pt 0 (car xylst)))
)
)

aimisiyou

;;;多余的部分应算入下一次循环中，如图
(defun c:tt()
(defun xl (LA LB c d)
(defun LF (c d)   ;;;c>d
  (setq lst nil)
  (if (= (rem c d) 0)
      (setq lst (list (/ c d)))
      (setq lst (cons (/ c d) (LF d (rem c d))))
   )
)
(defun HF (lst)
   (if (<= (length lst) 2)
       (if (= (length lst) 2)
           (setq va (list (+ 1 (* (car lst)(cadr lst))) (cadr lst)))
                   (setq va (list (car lst) 1))
                )
           (setq va (list (+ (cadr (HF (cdr lst))) (* (car lst)(car (HF (cdr lst))))) (car (HF (cdr lst)))))
  )
)
(defun FCC(k1 k2 c d)
  (if (= d 1)
      (setq num_cc (* k1 k2 c))
          (progn
        (if (= (rem (length (LF c d)) 2) 0)
                (setq cd (HF (reverse (cdr (reverse (LF c d))))))
                (setq cd (HF (reverse (cons (- (last (LF c d)) 1) (cdr (reverse (LF c d)))))))
         )
        (setq r2 (rem k1 (cadr cd)))
        (setq t2 (rem k2 (cadr cd)))
        (setq num_cc (+ (* (/ k1 (cadr cd)) k2 (car cd))  (* (/ k2 (cadr cd)) r2 (car cd))  (FCC r2 t2 (car cd) (cadr cd))))
                )
    )
)
(defun FDD (k1 k2 c d)
  (if (= d 1)
      (setq num_cc (max (+ (* k2 (/ k1 c)) (* (rem k1 c) (/ k2 c)))
                            (+ (* k1 (/ k2 c)) (* (rem k2 c) (/ k1 c)))
                                        )
           )
          (progn
        (if (= (rem (length (LF c d)) 2) 0)
                (setq cd (HF (reverse (cons (- (last (LF c d)) 1) (cdr (reverse (LF c d)))))))
                (setq cd (HF (reverse (cdr (reverse (LF c d))))))
         )
        (setq r1 (rem k1 (car cd)))
        (setq t1 (rem k2 (car cd)))
        (setq num_cc (+ (* (/ k1 (car cd)) k2 (cadr cd))  (* (/ k2 (car cd)) r1 (cadr cd))  (FDD r1 t1 (car cd) (cadr cd))))
                )
    )
)
(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
)
(if (/= (last (ff (rem LA (* c d)) c d nil)) 0)
   (if (> LA (* c d))
      (progn
        (setq na (- (/ LA (* c d)) 1))
        (setq lsta (ff (+ (* c d)(rem LA (* c d))) c d nil))
       )
      (progn
        (setq na 0)
        (setq lsta (ff LA c d nil))
       )
        )
   (progn
       (setq na (/ LA (* c d)))
       (setq lsta (ff (rem LA (* c d)) c d nil))
    )
)
(if (/= (last (ff (rem LB (* c d)) c d nil)) 0)
   (if (> LB (* c d))
       (progn
          (setq nb (- (/ LB (* c d)) 1))
          (setq lstb (ff (+ (* c d)(rem LB (* c d))) c d nil))
        )
       (progn
          (setq nb 0)
          (setq lstb (ff LB c d nil))
        )
        )
    (progn
       (setq nb (/ LB (* c d)))
       (setq lstb (ff (rem LB (* c d)) c d nil))
     )
)
(if (or (< (min LA LB) d) (< (max LA LB) c))
    (setq num 0)
    (setq num (+ (* na nb c d)
             (* (car lsta) nb c)
                         (* (cadr lsta) nb d)
                         (* (car lstb) na c)
                         (* (cadr lstb) na d)                        
                         (* (car lsta) (cadr lstb))                        
                         (* (cadr lsta) (car lstb))
                         (FCC (car lsta) (car lstb) c d)
                         (FDD (cadr lsta) (cadr lstb) c d)
                   )
       )
)
)
(defun jq(LA LB a b)
(if (= (rem LA b) (rem LB a) 0)
  (setq vat (list 0 0 0))
  (progn
   (setq x LA)
   (setq flag t)
   (while (and flag (>= x 0))
     (setq y LB)
     (while (and flag (>= y 0))
     (if (= (xl LA LB a b)
            (max (+ (* (/ x a) (/ LB b)) (* (/ (- LA x) b) (/ (- LB y) a)) (xl (- LA x) y a b))
                 (+ (* (/ x a) (/ y b)) (* (/ LA b) (/ (- LB y) a)) (xl (- LA x) y a b))
                     )
              )
             (progn
                 (setq flag nil)
                 (if (>= (+ (* (/ x a) (/ LB b)) (* (/ (- LA x) b) (/ (- LB y) a)))
                     (+ (* (/ x a) (/ y b)) (* (/ LA b) (/ (- LB y) a)))
                  )
              (setq vat (list x y 1))
                  (setq vat (list x y 0))
                          )
              )
             (if flag (setq y (- y 1)))
           )
           )
             (if flag (setq x (- x 1)))
     )
        )
   )
   vat
)

(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)
       )      
)
(setq pt (getpoint "\n插入点位置："))
(setq LA (getint "母材长边长度\nLA=：")
      LB (getint "母材短边长度\nLB=：")
      c (getint "构件长边长度\nc=：")
      d (getint "构件短边长度\nd=：")
)
(entmake
        (list
                '(0 . "LWPOLYLINE")                        
                '(100 . "AcDbEntity")
                '(100 . "AcDbPolyline")
                '(90 . 4)                                 
                '(70 . 1)                                 
                (cons 10 (list (car pt) (cadr pt)))
                (cons 10 (list (+ (car pt) LA) (cadr pt)))
                (cons 10 (list (+ (car pt) LA) (+ (cadr pt) LB)))
                (cons 10 (list (car pt) (+ (cadr pt) LB)))            
                (cons 210 '(0 0 1))   
          )                     
)
(while (and (>= (min LA LB) d) (>= (max LA LB) c))
     (setq xylst (jq LA LB c d))
         (if (= (caddr xylst) 0)
             (progn
           (drawmore pt (/ (car xylst) c)(/ (cadr xylst) d) c d)
                   (setq dis1 (rem LA d))
           (setq dis2 (rem (- LB (cadr xylst)) c))
           (drawmore (polar (polar pt (/ pi 2) (+ (cadr xylst) dis2)) 0 dis1) (/ LA d)(/ (- LB (cadr xylst)) c) d c)
                 )
             (progn
           (drawmore pt (/ (car xylst) c)(/ LB d) c d)
                   (setq dis1 (rem (- LA (car xylst)) d))
           (setq dis2 (rem (- LB (cadr xylst)) c))
           (drawmore (polar (polar pt (/ pi 2) (+ (cadr xylst) dis2)) 0 dis1) (/ (- LA (car xylst)) d)(/ (- LB (cadr xylst)) c) d c)
                 )
           )
           (setq LA (+ (- LA (car xylst)) (rem (car xylst) c)))
           (setq LB (+ (cadr xylst) (rem (- LB (cadr xylst)) c) ))
           (setq pt (polar pt 0 (- (car xylst) (rem (car xylst) c))))
)
)