二维下料

aimisiyou

(defun hefun (lst)
   (setq i 0 vlst nil n (length lst) )
   (while (< i n)
        (setq a (nth i lst) j 0 sum 0 flag t)
        (while (and flag (< j n))
           (setq b (nth j lst))
           (if (and (<= (car b)  (car a) )
                    (<= (cadr b) (cadr a))
                    (<= (+ (car a) (caddr a) ) (+ (car b) (caddr b) ))
                    (<= (+ (cadr a) (cadddr a) ) (+ (cadr b) (cadddr b) ))
               )
              (setq sum (+ 1 sum))
            )
           (setq j (+ j 1))
           (if (> sum 1) (setq flag nil))
         )
       (if flag (setq vlst (cons a vlst)))
       (setq i (+ i 1))
  )
  (reverse vlst)
)
HEFUN
_$ (hefun '((100 100 80 60)(120 110 40 30)(90 140 60 80)))
((100 100 80 60) (90 140 60 80))

aimisiyou

_$ (setq lst '((1 12 6) (2 4 7) (3 6 7) (4 10 2) (5 2 5) (6 6 4)(7 4 2) (8 4 6)(9 7 9)(10 4 5)))
(setq mlst '(1 2 3 4 5 6 7 8 9 10))
(setq rlst  '(1 0 0 1 0 1 0 1 0 1))
(setq slst '((0 0 20 50)))
(defun refun (lst mlst rlst)
    (setq i 0 n (length lst) valst nil)
    (while (< i n)
          (setq pt (cdr (assoc (nth i mlst) lst)))
          (if (= 0 (nth i rlst))
              (setq valst (cons pt valst))
              (setq valst (cons (reverse pt) valst))
           )
           (setq i (+ i 1))
    )
   (reverse valst)
)
(setq ptlst (refun lst mlst rlst))
((1 12 6) (2 4 7) (3 6 7) (4 10 2) (5 2 5) (6 6 4) (7 4 2) (8 4 6) (9 7 9) (10 4 5))
(1 2 3 4 5 6 7 8 9 10)
(1 0 0 1 0 1 0 1 0 1)
((0 0 20 50))
REFUN
((6 12) (4 7) (6 7) (2 10) (2 5) (4 6) (4 2) (6 4) (7 9) (5 4))
_$

aimisiyou

_$ (defun drawfun (pt slst)
   (setq i 0 n (length slst) flag t)
   (while (and flag (< i n))
           (setq sg (nth i slst))
           (if (and (<= (car pt) (caddr sg)) (<= (cadr pt) (cadddr sg)) )
               (progn
                    (setq flag nil)              
                    (entmake
                             (list
                                  '(0 . "LWPOLYLINE")                        
                                  '(100 . "AcDbEntity")
                                  '(100 . "AcDbPolyline")
                                  '(90 . 4)                                 
                                  '(70 . 1)                                 
                                  (cons 10 (list (car sg) (cadr sg)))
                                  (cons 10 (list (+ (car sg) (car pt)) (cadr sg) ))
                                  (cons 10 (list (+ (car sg) (car pt)) (+ (cadr sg) (cadr pt)) ))
                                  (cons 10 (list (car sg) (+ (cadr sg) (cadr pt)) )  )            
                                  (cons 210 '(0 0 1))   
                               )                     
                      )
               )
               (setq i (+ 1 i))
           )
   )
)
(drawfun '(10 15) '((0 0 20 50)))
DRAWFUN
((0 . "LWPOLYLINE") (100 . "AcDbEntity") (100 . "AcDbPolyline") (90 . 4) (70 . 1) (10 0 0) (10 10 0) (10 10 15) (10 0 15) (210 0 0 1))
_$

aimisiyou

;;;运行结果如图
(defun fenfun (s r)
  (cond
      ((and (= (car r) (car s))
            (= (cadr r) (cadr s))
            (= (caddr r) (caddr s))
            (= (cadddr r) (cadddr s))  
         )      
        (setq va nil)
      )     
      ((and (<= (car r) (car s))
            (<= (cadr r) (cadr s))
            (< (car s) (+ (car r) (caddr r)) (+ (car s) (caddr s)))
            (< (cadr s) (+ (cadr r) (cadddr r)) (+ (cadr s) (cadddr s)))  
          )      
         (setq va (list
                       (list (car s) (+ (cadr r) (cadddr r)) (caddr s) (- (+ (cadr s) (cadddr s)) (+ (cadr r) (cadddr r))) )
                       (list (+ (car r) (caddr r)) (cadr s)  (- (+ (car s) (caddr s)) (+ (car r) (caddr r))) (cadddr s))
                   )
          )
       )
      ((and (= (car r) (car s))
            (< (cadr r) (cadr s))
            (< (caddr r) (caddr s))
            (< (cadr s) (+ (cadr r) (cadddr r)) (+ (cadr s) (cadddr s)))  
          )
         (setq va (list
                       (list (car s) (+ (cadr r) (cadddr r)) (caddr s) (- (+ (cadr s) (cadddr s)) (+ (cadr r) (cadddr r))) )
                       (list (+ (car r) (caddr r)) (cadr s)  (- (+ (car s) (caddr s)) (+ (car r) (caddr r))) (cadddr s))
                  )
          )
       )
      ((and (< (car s ) (car r ) (+ (car r) (caddr r)) (+ (car s) (caddr s)))
            (< (cadr r) (cadr s) (+ (cadr r) (cadddr r)) (+ (cadr s) (cadddr s)))  
        )
        (setq va (list
                       (list (car s) (cadr s) (- (car r)(car s)) (cadddr s) )
                       (list (car s) (+ (cadr r) (cadddr r)) (caddr s)  (- (+ (cadr s) (cadddr s)) (+ (cadr r) (cadddr r))))
                       (list (+ (car r) (caddr r)) (cadr s) (- (+ (car s) (caddr s)) (+ (car r) (caddr r))) (cadddr s))
                  )
          )
       )
      ((and (< (car s ) (car r ) (+ (car s) (caddr s)) )
            (<= (+ (car s) (caddr s)) (+ (car r) (caddr r)) )
            (< (cadr r) (cadr s) (+ (cadr r) (cadddr r)) (+ (cadr s) (cadddr s)))  
        )
        (setq va (list
                       (list (car s) (cadr s) (- (car r) (car s))(cadddr s) )
                       (list (car s) (+ (cadr r) (cadddr r))  (caddr s)  (- (+ (cadr s) (cadddr s)) (+ (cadr r) (cadddr r))))
                  )
          )
       )
      ((and (= (+ (cadr s) (cadddr s)) (+ (cadr r) (cadddr r)) )
            (<= (car r ) (car s ) )
            (< (car s)  (+ (car r) (caddr r)) (+ (car s) (caddr s)))
            (<= (cadr r) (cadr s) )  
        )
        (setq va (list
                       (list (+ (car r) (caddr r)) (cadr s) (- (+ (car s) (caddr s)) (+ (car r) (caddr r))) (cadddr s) )
                  )
          )
       )
      ((and (= (+ (cadr s) (cadddr s)) (+ (cadr r) (cadddr r)) )
            (< (car s ) (car r ) (+ (car r) (caddr r)) (+ (car s) (caddr s)))
            (< (cadr r) (cadr s) )  
        )
        (setq va (list
                       (list (car s ) (cadr s ) (- (car r) (car s))(cadddr s) )
                       (list (+ (car r) (caddr r)) (cadr s) (- (+ (car s) (caddr s)) (+ (car r) (caddr r))) (cadddr s) )
                  )
          )
       )
      ((and (= (+ (cadr s) (cadddr s)) (+ (cadr r) (cadddr r)) )
            (< (car s ) (car r )  (+ (car s) (caddr s)))
            (<= (cadr s) (+ (car r) (caddr r)))
            (< (cadr r) (cadr s) )  
        )
        (setq va (list
                       (list (car s ) (cadr s ) (- (car r) (car s))(cadddr s) )
                  )
          )
       )
      ((and (< (car s ) (car r )  (+ (car s) (caddr s)) (+ (car r) (caddr r)))
            (< (+ (cadr r) (cadddr r)) (+ (cadr s) (cadddr s)))
            (= (cadr r) (cadr s) )  
        )
        (setq va (list
                       (list (car s ) (cadr s ) (- (car r) (car s))(cadddr s) )
                       (list (car s ) (+ (cadr r)(cadddr r)) (caddr s)(- (cadddr s)(cadddr r)))
                  )
          )
       )
      ((and (<= (car r ) (car s )  (+ (car s) (caddr s)) (+ (car r) (caddr r)))
            (< (+ (cadr r) (cadddr r)) (+ (cadr s) (cadddr s)))
            (= (cadr r) (cadr s) )  
        )
        (setq va (list
                       (list (car s ) (+ (cadr r)(cadddr r)) (caddr s) (- (cadddr s)(cadddr r)))
                  )
          )
       )
      ((and (< (car r ) (car s ) (+ (car r) (caddr r)) (+ (car s) (caddr s)) )
            (< (+ (cadr r) (cadddr r)) (+ (cadr s) (cadddr s)))
            (= (cadr r) (cadr s) )  
        )
        (setq va (list
                       (list (car s ) (+ (cadr r)(cadddr r)) (caddr s) (- (cadddr s)(cadddr r)))
                       (list (+ (car r) (caddr r)) (cadr s ) (- (+ (car s) (caddr s)) (+ (car r) (caddr r))) (cadddr s))
                  )
          )
       )
      ((and (< (car s ) (car r ) (+ (car s) (caddr s)) (+ (car r) (caddr r)) )
            (< (cadr s ) (cadr r ) (+ (cadr r) (cadddr r)) (+ (cadr s) (cadddr s)) )
        )
        (setq va (list
                       (list (car s)(cadr s)(caddr s) (- (cadr r) (cadr s)) )
                       (list (car s)(cadr s) (- (car r) (car s)) (cadddr s))
                       (list (car s)(+ (cadr r) (cadddr r)) (caddr s ) (- (+ (cadr s) (cadddr s)) (+ (cadr r) (cadddr r))) )
                  )
          )
       )
      ((and (<= (car r ) (car s) (+ (car s) (caddr s)) (+ (car r) (caddr r)) )
            (< (cadr s ) (cadr r ) (+ (cadr r) (cadddr r)) (+ (cadr s) (cadddr s)) )
        )
        (setq va (list
                       (list (car s)(cadr s)(caddr s) (- (cadr r) (cadr s)) )
                       (list (car s)(+ (cadr r) (cadddr r)) (caddr s ) (- (+ (cadr s) (cadddr s)) (+ (cadr r) (cadddr r))) )
                  )
          )
       )
      ((and (< (car r ) (car s ) (+ (car r) (caddr r)) (+ (car s) (caddr s)) )
            (< (cadr s ) (cadr r ) (+ (cadr r) (cadddr r)) (+ (cadr s) (cadddr s)) )
        )
        (setq va (list
                       (list (car s)(cadr s)(caddr s) (- (cadr r) (cadr s)) )
                       (list (+ (car r)(caddr r)) (cadr s) (- (+ (car s) (caddr s)) (+ (car r) (caddr r))) (cadddr s))
                       (list (car s)(+ (cadr r) (cadddr r)) (caddr s ) (- (+ (cadr s) (cadddr s)) (+ (cadr r) (cadddr r))) )
                  )
          )
       )
      ((and (< (car s ) (car r )  (+ (car s) (caddr s)) (+ (car r) (caddr r)))
            (< (cadr s ) (cadr r ))
            (= (+ (cadr s) (cadddr s)) (+ (cadr r) (cadddr r)))
        )
        (setq va (list
                       (list (car s ) (cadr s )(- (car r) (car s))(cadddr s) )
                       (list (car s ) (cadr s )(caddr s)(- (cadr r) (cadr s)) )
                  )
          )
       )
      ((and (<= (car r ) (car s )  (+ (car s) (caddr s)) (+ (car r) (caddr r)))
            (< (cadr s ) (cadr r ))
            (= (+ (cadr s) (cadddr s)) (+ (cadr r) (cadddr r)))  
        )
        (setq va (list
                       (list (car s ) (cadr s )(caddr s)(- (cadr r) (cadr s)) )
                  )
          )
       )
      ((and (< (car r ) (car s )  (+ (car r) (caddr r)) (+ (car s) (caddr s)))
            (< (cadr s ) (cadr r ))
            (= (+ (cadr s) (cadddr s)) (+ (cadr r) (cadddr r)))  
        )
        (setq va (list
                       (list (car s ) (cadr s )(caddr s)(- (cadddr s) (cadddr r)) )
                       (list (+ (car r)(caddr r)) (cadr s) (- (+ (cadr s) (cadddr s)) (+ (cadr r) (cadddr r))) (cadddr s) )
                  )
          )
       )
       (t (setq va (list s)))
)
)
(defun hefun (lst)
   (setq i 0 vlst nil n (length lst) )
   (while (< i n)
        (setq a (nth i lst) j 0 sum 0 flag t)
        (while (and flag (< j n))
           (setq b (nth j lst))
           (if (and (<= (car b)  (car a) )
                    (<= (cadr b) (cadr a))
                    (<= (+ (car a) (caddr a) ) (+ (car b) (caddr b) ))
                    (<= (+ (cadr a) (cadddr a) ) (+ (cadr b) (cadddr b) ))
               )
              (setq sum (+ 1 sum))
            )
           (setq j (+ j 1))
           (if (> sum 1) (setq flag nil))
         )
       (if flag (setq vlst (cons a vlst)))
       (setq i (+ i 1))
  )
  (reverse vlst)
)
(defun sortfun (juxlst)
   (vl-sort juxlst
             '(lambda (a b)
                      (if  (= (cadr a) (cadr b))
                           (<= (car a) (car b))
                           (< (cadr a) (cadr b))
                        )
              )
    )
)
(defun drawfun (pt slst)
   (setq i 0 n (length slst) flag t newslst slst )
   (while (and flag (< i n))
           (setq sg (nth i slst))
           (if (and (<= (car pt) (caddr sg)) (<= (cadr pt) (cadddr sg)) )
               (progn
                    (setq flag nil)
                    (setq r (list (car sg) (cadr sg) (car pt) (cadr pt)) vlst nil)
                    (foreach a slst
                             (setq vlst (append  (fenfun a r) vlst))
                     )
                    (setq newslst (sortfun (hefun vlst )))
                    (entmake
                             (list
                                  '(0 . "LWPOLYLINE")                        
                                  '(100 . "AcDbEntity")
                                  '(100 . "AcDbPolyline")
                                  '(90 . 4)                                 
                                  '(70 . 1)                                 
                                  (cons 10 (list (car sg) (cadr sg)))
                                  (cons 10 (list (+ (car sg) (car pt)) (cadr sg) ))
                                  (cons 10 (list (+ (car sg) (car pt)) (+ (cadr sg) (cadr pt)) ))
                                  (cons 10 (list (car sg) (+ (cadr sg) (cadr pt)) )  )            
                                  (cons 210 '(0 0 1))   
                               )                     
                      )
               )
               (setq i (+ 1 i))
           )
   )
  newslst
)
(defun refun (lst mlst rlst)
    (setq i 0 n (length lst) valst nil)
    (while (< i n)
          (setq pt (cdr (assoc (nth i mlst) lst)))
          (if (= 0 (nth i rlst))
              (setq valst (cons pt valst))
              (setq valst (cons (reverse pt) valst))
           )
           (setq i (+ i 1))
    )
   (reverse valst)
)
(setq lst '((1 12 6) (2 4 7) (3 6 7) (4 10 2) (5 2 5) (6 6 4)(7 4 2) (8 4 6)(9 7 9)(10 4 5)))
(setq mlst '(1 2 3 4 5 6 7 8 9 10))
(setq rlst  '(1 0 0 1 0 1 0 1 0 1))
(setq slst '((0 0 20 50)))
(entmake
        (list
                '(0 . "LWPOLYLINE")                        
                '(100 . "AcDbEntity")
                '(100 . "AcDbPolyline")
                '(90 . 4)                                 
                '(70 . 1)                                 
                (cons 10 (list (car (car slst)) (cadr (car slst))))
                (cons 10 (list (+ (car (car slst)) (caddr (car slst))) (cadr (car slst)) ))
                (cons 10 (list (+ (car (car slst)) (caddr (car slst))) (+ (cadr (car slst)) (cadddr (car slst))) ))
                (cons 10 (list (car (car slst)) (+ (cadr (car slst)) (cadddr (car slst))) )  )            
                (cons 210 '(0 0 1))   
          )                     
)
(setq ptlst (refun lst mlst rlst))
(foreach b ptlst
         (setq slst (drawfun b slst))
)

aimisiyou

对于单一规格情形，可以简化，只需随机生成各状态组成的列表，其长度为理论上可排放的最大数，取利用率最高的一组列表，即此时排放方式最优。当然，在列表长度较大时，需要生成的随机列表数量较大才能获得近优解，需要进一步优化。

aimisiyou

(setq lst '((1 10 7)(2 10 7)(3 10 7)(4 10 7)(5 10 7)(6 10 7)(7 10 7)(8 10 7)(9 10 7)(10 10 7)(11 10 7)(12 10 7)(13 10 7)(14 10 7)(15 10 7)(16 10 7)(17 10 7)(18 10 7)(19 10 7)(20 10 7)(21 10 7)(22 10 7)(23 10 7)(24 10 7)(25 10 7) ))
(setq mlst '(1 2 3  4 5 6 7 8 9 10 1 12 13 14 15 16 17 18 19 20 21 22 23 24 25 ))
(setq rlst  '(0 0 1 1 1 0 0 1 1 1 0 0 1 1 1 0 0 1 1 1 0 0 1 1 1 ))
(setq slst '((0 0 41 44)))
(entmake
        (list
                '(0 . "LWPOLYLINE")                        
                '(100 . "AcDbEntity")
                '(100 . "AcDbPolyline")
                '(90 . 4)                                 
                '(70 . 1)                                 
                (cons 10 (list (car (car slst)) (cadr (car slst))))
                (cons 10 (list (+ (car (car slst)) (caddr (car slst))) (cadr (car slst)) ))
                (cons 10 (list (+ (car (car slst)) (caddr (car slst))) (+ (cadr (car slst)) (cadddr (car slst))) ))
                (cons 10 (list (car (car slst)) (+ (cadr (car slst)) (cadddr (car slst))) )  )            
                (cons 210 '(0 0 1))   
          )                     
)
(setq ptlst (refun lst mlst rlst))
(foreach b ptlst
         (setq slst (drawfun b slst))
)

aimisiyou

(setq lst '((1 10 7)(2 10 7)(3 10 7)(4 10 7)(5 10 7)(6 10 7)(7 10 7)(8 10 7)(9 10 7)(10 10 7)(11 10 7)(12 10 7)(13 10 7)(14 10 7)(15 10 7)(16 10 7)(17 10 7)(18 10 7)(19 10 7)(20 10 7)(21 10 7)(22 10 7)(23 10 7)(24 10 7)(25 10 7) ))
(setq mlst '(1 2 3  4 5 6 7 8 9 10 1 12 13 14 15 16 17 18 19 20 21 22 23 24 25 ))
(setq rlst  '(0 0 0 1 1 0 0 0 1 1 0 0 0 1 1 0 0 0 1 1 0 0 0 1 1 ))
(setq slst '((0 0 44 41)))
(entmake
        (list
                '(0 . "LWPOLYLINE")                        
                '(100 . "AcDbEntity")
                '(100 . "AcDbPolyline")
                '(90 . 4)                                 
                '(70 . 1)                                 
                (cons 10 (list (car (car slst)) (cadr (car slst))))
                (cons 10 (list (+ (car (car slst)) (caddr (car slst))) (cadr (car slst)) ))
                (cons 10 (list (+ (car (car slst)) (caddr (car slst))) (+ (cadr (car slst)) (cadddr (car slst))) ))
                (cons 10 (list (car (car slst)) (+ (cadr (car slst)) (cadddr (car slst))) )  )            
                (cons 210 '(0 0 1))   
          )                     
)
(setq ptlst (refun lst mlst rlst))
(foreach b ptlst
         (setq slst (drawfun b slst))
)

aimisiyou

(defun c:tt ()
(defun fenfun (s r)
  (cond
      ((and (= (car r) (car s))
            (= (cadr r) (cadr s))
            (= (caddr r) (caddr s))
            (= (cadddr r) (cadddr s))  
         )      
        (setq va nil)
      )     
      ((and (<= (car r) (car s))
            (<= (cadr r) (cadr s))
            (< (car s) (+ (car r) (caddr r)) (+ (car s) (caddr s)))
            (< (cadr s) (+ (cadr r) (cadddr r)) (+ (cadr s) (cadddr s)))  
          )      
         (setq va (list
                       (list (car s) (+ (cadr r) (cadddr r)) (caddr s) (- (+ (cadr s) (cadddr s)) (+ (cadr r) (cadddr r))) )
                       (list (+ (car r) (caddr r)) (cadr s)  (- (+ (car s) (caddr s)) (+ (car r) (caddr r))) (cadddr s))
                   )
          )
       )
      ((and (= (car r) (car s))
            (< (cadr r) (cadr s))
            (< (caddr r) (caddr s))
            (< (cadr s) (+ (cadr r) (cadddr r)) (+ (cadr s) (cadddr s)))  
          )
         (setq va (list
                       (list (car s) (+ (cadr r) (cadddr r)) (caddr s) (- (+ (cadr s) (cadddr s)) (+ (cadr r) (cadddr r))) )
                       (list (+ (car r) (caddr r)) (cadr s)  (- (+ (car s) (caddr s)) (+ (car r) (caddr r))) (cadddr s))
                  )
          )
       )
      ((and (< (car s ) (car r ) (+ (car r) (caddr r)) (+ (car s) (caddr s)))
            (< (cadr r) (cadr s) (+ (cadr r) (cadddr r)) (+ (cadr s) (cadddr s)))  
        )
        (setq va (list
                       (list (car s) (cadr s) (- (car r)(car s)) (cadddr s) )
                       (list (car s) (+ (cadr r) (cadddr r)) (caddr s)  (- (+ (cadr s) (cadddr s)) (+ (cadr r) (cadddr r))))
                       (list (+ (car r) (caddr r)) (cadr s) (- (+ (car s) (caddr s)) (+ (car r) (caddr r))) (cadddr s))
                  )
          )
       )
      ((and (< (car s ) (car r ) (+ (car s) (caddr s)) )
            (<= (+ (car s) (caddr s)) (+ (car r) (caddr r)) )
            (< (cadr r) (cadr s) (+ (cadr r) (cadddr r)) (+ (cadr s) (cadddr s)))  
        )
        (setq va (list
                       (list (car s) (cadr s) (- (car r) (car s))(cadddr s) )
                       (list (car s) (+ (cadr r) (cadddr r))  (caddr s)  (- (+ (cadr s) (cadddr s)) (+ (cadr r) (cadddr r))))
                  )
          )
       )
      ((and (= (+ (cadr s) (cadddr s)) (+ (cadr r) (cadddr r)) )
            (<= (car r ) (car s ) )
            (< (car s)  (+ (car r) (caddr r)) (+ (car s) (caddr s)))
            (<= (cadr r) (cadr s) )  
        )
        (setq va (list
                       (list (+ (car r) (caddr r)) (cadr s) (- (+ (car s) (caddr s)) (+ (car r) (caddr r))) (cadddr s) )
                  )
          )
       )
      ((and (= (+ (cadr s) (cadddr s)) (+ (cadr r) (cadddr r)) )
            (< (car s ) (car r ) (+ (car r) (caddr r)) (+ (car s) (caddr s)))
            (< (cadr r) (cadr s) )  
        )
        (setq va (list
                       (list (car s ) (cadr s ) (- (car r) (car s))(cadddr s) )
                       (list (+ (car r) (caddr r)) (cadr s) (- (+ (car s) (caddr s)) (+ (car r) (caddr r))) (cadddr s) )
                  )
          )
       )
      ((and (= (+ (cadr s) (cadddr s)) (+ (cadr r) (cadddr r)) )
            (< (car s ) (car r )  (+ (car s) (caddr s)))
            (<= (cadr s) (+ (car r) (caddr r)))
            (< (cadr r) (cadr s) )  
        )
        (setq va (list
                       (list (car s ) (cadr s ) (- (car r) (car s))(cadddr s) )
                  )
          )
       )
      ((and (< (car s ) (car r )  (+ (car s) (caddr s)) (+ (car r) (caddr r)))
            (< (+ (cadr r) (cadddr r)) (+ (cadr s) (cadddr s)))
            (= (cadr r) (cadr s) )  
        )
        (setq va (list
                       (list (car s ) (cadr s ) (- (car r) (car s))(cadddr s) )
                       (list (car s ) (+ (cadr r)(cadddr r)) (caddr s)(- (cadddr s)(cadddr r)))
                  )
          )
       )
      ((and (<= (car r ) (car s )  (+ (car s) (caddr s)) (+ (car r) (caddr r)))
            (< (+ (cadr r) (cadddr r)) (+ (cadr s) (cadddr s)))
            (= (cadr r) (cadr s) )  
        )
        (setq va (list
                       (list (car s ) (+ (cadr r)(cadddr r)) (caddr s) (- (cadddr s)(cadddr r)))
                  )
          )
       )
      ((and (< (car r ) (car s ) (+ (car r) (caddr r)) (+ (car s) (caddr s)) )
            (< (+ (cadr r) (cadddr r)) (+ (cadr s) (cadddr s)))
            (= (cadr r) (cadr s) )  
        )
        (setq va (list
                       (list (car s ) (+ (cadr r)(cadddr r)) (caddr s) (- (cadddr s)(cadddr r)))
                       (list (+ (car r) (caddr r)) (cadr s ) (- (+ (car s) (caddr s)) (+ (car r) (caddr r))) (cadddr s))
                  )
          )
       )
      ((and (< (car s ) (car r ) (+ (car s) (caddr s)) (+ (car r) (caddr r)) )
            (< (cadr s ) (cadr r ) (+ (cadr r) (cadddr r)) (+ (cadr s) (cadddr s)) )
        )
        (setq va (list
                       (list (car s)(cadr s)(caddr s) (- (cadr r) (cadr s)) )
                       (list (car s)(cadr s) (- (car r) (car s)) (cadddr s))
                       (list (car s)(+ (cadr r) (cadddr r)) (caddr s ) (- (+ (cadr s) (cadddr s)) (+ (cadr r) (cadddr r))) )
                  )
          )
       )
      ((and (<= (car r ) (car s) (+ (car s) (caddr s)) (+ (car r) (caddr r)) )
            (< (cadr s ) (cadr r ) (+ (cadr r) (cadddr r)) (+ (cadr s) (cadddr s)) )
        )
        (setq va (list
                       (list (car s)(cadr s)(caddr s) (- (cadr r) (cadr s)) )
                       (list (car s)(+ (cadr r) (cadddr r)) (caddr s ) (- (+ (cadr s) (cadddr s)) (+ (cadr r) (cadddr r))) )
                  )
          )
       )
      ((and (< (car r ) (car s ) (+ (car r) (caddr r)) (+ (car s) (caddr s)) )
            (< (cadr s ) (cadr r ) (+ (cadr r) (cadddr r)) (+ (cadr s) (cadddr s)) )
        )
        (setq va (list
                       (list (car s)(cadr s)(caddr s) (- (cadr r) (cadr s)) )
                       (list (+ (car r)(caddr r)) (cadr s) (- (+ (car s) (caddr s)) (+ (car r) (caddr r))) (cadddr s))
                       (list (car s)(+ (cadr r) (cadddr r)) (caddr s ) (- (+ (cadr s) (cadddr s)) (+ (cadr r) (cadddr r))) )
                  )
          )
       )
      ((and (< (car s ) (car r )  (+ (car s) (caddr s)) (+ (car r) (caddr r)))
            (< (cadr s ) (cadr r ))
            (= (+ (cadr s) (cadddr s)) (+ (cadr r) (cadddr r)))
        )
        (setq va (list
                       (list (car s ) (cadr s )(- (car r) (car s))(cadddr s) )
                       (list (car s ) (cadr s )(caddr s)(- (cadr r) (cadr s)) )
                  )
          )
       )
      ((and (<= (car r ) (car s )  (+ (car s) (caddr s)) (+ (car r) (caddr r)))
            (< (cadr s ) (cadr r ))
            (= (+ (cadr s) (cadddr s)) (+ (cadr r) (cadddr r)))  
        )
        (setq va (list
                       (list (car s ) (cadr s )(caddr s)(- (cadr r) (cadr s)) )
                  )
          )
       )
      ((and (< (car r ) (car s )  (+ (car r) (caddr r)) (+ (car s) (caddr s)))
            (< (cadr s ) (cadr r ))
            (= (+ (cadr s) (cadddr s)) (+ (cadr r) (cadddr r)))  
        )
        (setq va (list
                       (list (car s ) (cadr s )(caddr s)(- (cadddr s) (cadddr r)) )
                       (list (+ (car r)(caddr r)) (cadr s) (- (+ (cadr s) (cadddr s)) (+ (cadr r) (cadddr r))) (cadddr s) )
                  )
          )
       )
       (t (setq va (list s)))
)
)
(defun hefun (lst)
   (setq i 0 vlst nil n (length lst) )
   (while (< i n)
        (setq a (nth i lst) j 0 sum 0 flag t)
        (while (and flag (< j n))
           (setq b (nth j lst))
           (if (and (<= (car b)  (car a) )
                    (<= (cadr b) (cadr a))
                    (<= (+ (car a) (caddr a) ) (+ (car b) (caddr b) ))
                    (<= (+ (cadr a) (cadddr a) ) (+ (cadr b) (cadddr b) ))
               )
              (setq sum (+ 1 sum))
            )
           (setq j (+ j 1))
           (if (> sum 1) (setq flag nil))
         )
       (if flag (setq vlst (cons a vlst)))
       (setq i (+ i 1))
  )
  (reverse vlst)
)
(defun sortfun (juxlst)
   (vl-sort juxlst
             '(lambda (a b)
                      (if  (= (cadr a) (cadr b))
                           (<= (car a) (car b))
                           (< (cadr a) (cadr b))
                        )
              )
    )
)
(defun drawfun (pt slst)
   (setq i 0 n (length slst) flag t)
   (while (and flag (< i n))
           (setq sg (nth i slst))
           (if (and (<= (car pt) (caddr sg)) (<= (cadr pt) (cadddr sg)) )
               (progn
                    (setq flag nil)
                    (setq r (list (car sg) (cadr sg) (car pt) (cadr pt)) vlst nil)
                    (foreach a slst
                             (setq vlst (append  (fenfun a r) vlst))
                     )
                    (setq newslst (sortfun (hefun vlst )))
                    (entmake
                             (list
                                  '(0 . "LWPOLYLINE")                        
                                  '(100 . "AcDbEntity")
                                  '(100 . "AcDbPolyline")
                                  '(90 . 4)                                 
                                  '(70 . 1)                                 
                                  (cons 10 (list (car sg) (cadr sg)))
                                  (cons 10 (list (+ (car sg) (car pt)) (cadr sg) ))
                                  (cons 10 (list (+ (car sg) (car pt)) (+ (cadr sg) (cadr pt)) ))
                                  (cons 10 (list (car sg) (+ (cadr sg) (cadr pt)) )  )            
                                  (cons 210 '(0 0 1))   
                               )                     
                      )
               )
               (setq i (+ 1 i))
           )
   )
  newslst
)
(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 DB (getint "请输入短边DB长度=:"))
  (setq DA (getint "请输入长边DA长度=:"))
  (setq a (getint "请输入长边a长度=:"))
  (setq b (getint "请输入短边b长度=:"))
  (setq slst (list (list 0 0  DB  DA)))
  (entmake
        (list
                '(0 . "LWPOLYLINE")                        
                '(100 . "AcDbEntity")
                '(100 . "AcDbPolyline")
                '(90 . 4)                                 
                '(70 . 1)                                 
                (cons 10 (list (car (car slst)) (cadr (car slst))))
                (cons 10 (list (+ (car (car slst)) (caddr (car slst))) (cadr (car slst)) ))
                (cons 10 (list (+ (car (car slst)) (caddr (car slst))) (+ (cadr (car slst)) (cadddr (car slst))) ))
                (cons 10 (list (car (car slst)) (+ (cadr (car slst)) (cadddr (car slst))) )  )            
                (cons 210 '(0 0 1))   
          )                     
  )
  (setq kk (ff DB a b t))
  (setq nsum (/ (* DB DA) (* a b)))
  (setq ksum (+ 2 (/ nsum (+ (car kk) (cadr kk)))))
  (setq klst nil plst nil ptlst nil)
  (repeat (car kk)
      (setq klst (cons 0 klst))
  )
  (repeat (cadr kk)
      (setq klst (cons 1 klst))
  )
  (repeat ksum
      (setq plst (append klst plst))
  )
  (setq ptlst (mapcar '(lambda (x) (if (= x 0)
                                                (list a b)
                                                (list b a)
                                    )
                         )
                       (reverse plst)
               )
   )
  (foreach bb ptlst
         (setq slst (drawfun bb slst))
  )
)

qhdycm2016

这个太强了 赞一个

yzhyxh

aimisiyou

;;;采用递归求单一规格矩形下料个数（一刀切方式）
;;;只对毛坯个数比较少时有效，规模一大就运行无限长时间
(defun xl (DA DB a b)
(cond
   ((or (< (min DA DB) (min a b)) (< (max DA DB) (max a b)))  
    (setq va 0)
        )
        ((or (and (= DA a)(= DB b))(and (= DA b)(= DB a))) (setq va 1))
        ((and (> a b)(= DA b)(> DB a))
              (setq va  (/ DB a))
          )
        ((and (> a b)(< b DA a)(>= DB a))
               (setq va (max (+ (/ DB a) (xl (- DA b) DB a b))
                             (+ (/ DA a) (xl DA (- DB b) a b))
                             (+ (/ DA b) (xl DA (- DB a) a b))
                         )
                         )
          )
        ((and (> a b)(= DA a)(> a DB b))
               (setq va (/ DB b)
                        )
          )
        ((and (> a b)(= DA a)(>= DB a))
               (setq va (max (+ (/ DB a) (xl (- DA b) DB a b))
                         (+ (/ DB b) (xl (- DA a) DB a b))
                             (+ (/ DA a) (xl DA (- DB b) a b))
                             (+ (/ DA b) (xl DA (- DB a) a b))
                         )
                         )
          )
        ((and (> a b)(> DA a)(>= DB a))
               (setq va (max (+ (/ DB a) (xl (- DA b) DB a b))
                         (+ (/ DB b) (xl (- DA a) DB a b))
                             (+ (/ DA a) (xl DA (- DB b) a b))
                             (+ (/ DA b) (xl DA (- DB a) a b))
                         )
                         )
          )
        ((and (> a b)(> DA a)(> a DB b))
               (setq va (max (+ (/ DB a) (xl (- DA b) DB a b))
                         (+ (/ DB b) (xl (- DA a) DB a b))
                             (+ (/ DA a) (xl DA (- DB b) a b))
                         )
                         )
          )
        ((and (> a b)(> DA a)(= DB b))
               (setq va (/ DA a)
                   )
          )
        )
)
XL
_$ (xl  14 7 10 7)
1
_$ (xl  17 7 10 7)
1
_$ (xl  17 17 10 7)
3
_$ (xl  20 17 10 7)
4
_$
_$ (xl  34 17 10 7)
7
_$ (xl  34 34 10 7)
14
_$ (xl  51 34 10 7)
24
_$ (xl  51 51 10 7)
36
_$ (xl  58 51 10 7)
41
_$ (xl  59 57 10 7)
47

20180318

樓主!這些算法理論的書,能介紹嗎?

aimisiyou

初步实现了自动出图，剩下就是如何优化提高利用率。

aimisiyou

基本套路是定位+排序。零件排放顺序一般按面积从大到大小，长度由长到短等，但效果总是不尽如人意。看来需要改进排序规则。

ymcui2005

牛,太强了 赞一个