### Author Topic: Automatic Nesting for lisp？  (Read 25324 times)

0 Members and 1 Guest are viewing this topic.

#### well20152016

• Newt
• Posts: 130 ##### Re: Automatic Nesting for lisp？
« Reply #45 on: December 04, 2016, 10:52:26 AM »
How many kinds of large rectangular size by n small rectangle?

Result：((200 10) (180 10) (160 10) (140 10) (120 10) (100 20) (80 20) (60 30) (40 50)
(20 100))

Code - Auto/Visual Lisp: [Select]
1. (defun c:tt()
2.   (setq w 20 l 10 n 10)
3.   (setq p (getpoint"\n insertion point") b p i 1 lst nil)
4.   (repeat n
5.     (repeat i
6.        (repeat (fix(/ n i)) (LM:ENTMAKE-LWPOLYLINE (4boxs b w l)) (setq b (polar b 0 l)))
7.         (setq b (list (car p) (+ w (cadr b)))))
8.     (setq lst (cons(list (* i w) (* (fix(/ n i)) l)) lst) i (1+ i))
9.     (setq b (list (car p) (+ (cadr b) 4)))
10.     )
11. (princ "\n")
12. (princ lst)
13.
14. (defun 4boxs (p w l)
15.   (list p  (polar p (* 0.5 pi) w) (polar (polar p 0 l) (* 0.5 pi) w)  (polar p 0 l))
16. )
17.
18. (defun LM:ENTMAKE-LWPOLYLINE (lst  / p)
19.               (list (cons 0 "LWPOLYLINE")
20.                     (cons 100 "AcDbEntity")
21.                     (cons 100 "AcDbPolyline")
22.                     (cons 90 (length lst) )
23.                     (cons 70 1 )
24.                     (cons 62 2 )
25.               )
26.               (mapcar(function (lambda (p) (cons 10 p)))lst)
27. )))
28.

#### LULU1965

• Mosquito
• Posts: 16 ##### Re: Automatic Nesting for lisp？
« Reply #46 on: December 04, 2016, 02:05:58 PM »
Minimum possibile number of platea .... Thanks forma all Grazie tanto ##### Re: Automatic Nesting for lisp？
« Reply #47 on: December 04, 2016, 08:27:13 PM »
@well20152016:
I think the result should be:
((200 10) (100 20) (40 50) (20 100))

#### well20152016

• Newt
• Posts: 130 ##### Re: Automatic Nesting for lisp？
« Reply #48 on: December 06, 2016, 07:51:18 AM »
Code - Auto/Visual Lisp: [Select]
1.
2. result:((200 10) (100 20) (40 50) (20 100))
3.
4. (defun c:tt()
5.   (setq w 20 l 10 n 10)
6.   (setq p (getpoint"\n insertion point") b p i 1 lst nil)
7.   (repeat n
8.    (if (equal (rem n i) 0 0) (progn
9.     (repeat i
10.        (repeat (fix(/ n i)) (LM:ENTMAKE-LWPOLYLINE (4boxs b w l)) (setq b (polar b 0 l)))
11.         (setq b (list (car p) (+ w (cadr b)))))
12.     (setq lst (cons(list (* i w) (* (fix(/ n i)) l)) lst) )))
13.     (setq i (1+ i))
14.     (setq b (list (car p) (+ (cadr b) 4)))
15.     )
16. (princ "\n")
17. (princ lst)
18.
19. (defun 4boxs (p w l)
20.   (list p  (polar p (* 0.5 pi) w) (polar (polar p 0 l) (* 0.5 pi) w)  (polar p 0 l))
21. )
22.
23. (defun LM:ENTMAKE-LWPOLYLINE (lst  / p)
24.               (list (cons 0 "LWPOLYLINE")
25.                     (cons 100 "AcDbEntity")
26.                     (cons 100 "AcDbPolyline")
27.                     (cons 90 (length lst) )
28.                     (cons 70 1 )
29.                     (cons 62 2 )
30.               )
31.               (mapcar(function (lambda (p) (cons 10 p)))lst)
32. )))
33.
34.

#### ahsattarian

• Newt
• Posts: 107 ##### Re: Automatic Nesting for lisp？
« Reply #49 on: January 19, 2021, 02:28:36 PM »
This works on several sheets   :

Code - Auto/Visual Lisp: [Select]
1. (defun c:nest ()
2.   (prompt "\n Select nesting 2D entities : ")
3.   (setq ss1 (ssget "_:L"))
4.   (prompt "\n Pick boundary rectangle to nest to :")
5.   (setq filter (list '(0 . "lwpolyline") '(90 . 4) '(-4 . "<or") '(70 . 1) '(70 . 129) '(-4 . "or>") '(-4 . "<not") '(-4 . "<>") '(42 . 0.0)
6.                      '(-4 . "not>"))
7.   )
8.   ;;(setq ss2 (ssget "_+.:E:S" filter))
9.   (setq ss2 (ssget filter))
10.   (setq el nil)
11.   (setq n1 (sslength ss1))
12.   (setq k1 -1)
13.   (repeat n1
14.     (setq k1 (1+ k1))
15.     (setq s1 (ssname ss1 k1))
16.     (setq obj1 (vlax-ename->vla-object s1))
17.     (vla-getboundingbox obj1 'eminp 'emaxp)
18.     (mapcar 'set '(eminp emaxp) (mapcar 'safearray-value (list eminp emaxp)))
19.     (setq ew (- (car emaxp) (car eminp)))
21.     (cond
22.       ((> ew eh)
23.        (setq po (mapcar '/ (mapcar '+ eminp emaxp) (list 2.0 2.0 2.0)))
24.        (vla-rotate obj1 (vlax-3d-point po) (* 0.5 pi))
25.        (vla-getboundingbox obj1 'eminp 'emaxp)
26.        (mapcar 'set '(eminp emaxp) (mapcar 'safearray-value (list eminp emaxp)))
27.        (setq ew (- (car emaxp) (car eminp)))
29.       )
30.     )
31.     (setq el (cons (list eminp ew eh s1) el))
32.   )
33.   (setq el (vl-sort el
34.                     '(lambda (a b)
38.                        )
39.                      )
40.            )
41.   )
42.   (setq n2 (sslength ss2))
43.   (setq k2 -1)
44.   (repeat n2
45.     (setq k2 (1+ k2))
46.     (setq s2 (ssname ss2 k2))
47.     (setq obj2 (vlax-ename->vla-object s2))
48.     (vla-getboundingbox obj2 'minp 'maxp)
49.     (mapcar 'set '(minp maxp) (mapcar 'safearray-value (list minp maxp)))
50.     (setq w (- (car maxp) (car minp)))
52.     (setq x nil)
53.     (setq y nil)
54.     (setq yn nil)
55.     (setq ell nil)
56.     (setq elll nil)
57.       (and
58.         (car el)
59.         (cond
60.           ((null x) (setq x 0.0) (setq y 0.0) (setq f x))
61.           ((> (+ x (cadar el)) w)
62.            (setq x 0.0)
63.            (foreach e elll (setq ell (vl-remove e ell)))
64.            (setq elll ell)
67.                     (reverse ell)
68.            )
69.            (cond ((> yn y) (setq y yn)))
70.            (setq f x)
71.           )
72.           (t
73.            (if
74.              (not
76.                         (reverse ell)
77.                )
78.              )
79.                 '(lambda (e)
80.                    (cond ((or (< (+ x (cadar el)) (car e)) (< (+ x 1e-3) (car e))) (setq yn (+ (cadr e) (caddr (caddr e))))))
81.                  )
82.                 (vl-sort ell '(lambda (a b) (> (car a) (car b))))
83.               )
84.            )
85.            (cond ((> yn y) (setq y yn)))
86.            (setq f x)
87.           )
88.         )
89.         (< f w)
90.         (or (< (+ y (caddar el)) h) (equal (+ y (caddar el)) h 1e-3))
91.       )
92.        (if (= x 0.0)
93.          (setq bp (list (car minp) (+ y (cadr minp)) 0.0))
94.          (setq bp (list (+ x (car minp)) (+ y (cadr minp)) 0.0))
95.        )
96.        (setq x (+ x (cadar el)))
97.        (vla-move (vlax-ename->vla-object (cadddr (car el))) (vlax-3d-point (caar el)) (vlax-3d-point bp))
98.        (setq ell (cons (list x y (car el)) ell))
99.        (setq el (cdr el))
100.     )
101.   )
102.   (princ)
103. )

#### ScottMC

• Newt
• Posts: 191 ##### Re: Automatic Nesting for lisp？
« Reply #50 on: January 21, 2021, 06:53:13 PM »
NICE lsp y'all!!

Tried for a bit to get the vars assigned and won't give.. responds with:

Command: NEST
; error: too few arguments

[a b bp e eh el ell elll ew f h k1 k2 n n2 n1 s1 s2
ss1 ss2 t w x y yn filter obj1 po eminp emaxp maxp minp]

vlide responds saying the "t" var is incorrect.

just feel safer having those vars assigned Thanks

Really like it for cut file setup!
« Last Edit: January 21, 2021, 06:58:42 PM by ScottMC »

#### ahsattarian

• Newt
• Posts: 107 ##### Re: Automatic Nesting for lisp？
« Reply #51 on: January 24, 2021, 11:59:01 AM »
Hello

T   is not used in my LISP  above  !!!

It works in my laptop.

R U sure about it? #### ScottMC

• Newt
• Posts: 191 ##### Re: Automatic Nesting for lisp？
« Reply #52 on: January 24, 2021, 07:06:39 PM »
Must be the "t" is not a variable .. really WAY over my head!

(t
(if
(not
(vl-some

had to play with it [takes alot for me to understand] still
like it very much but still would like to assign the local vars..
any help would be REALLY appreciated!! « Last Edit: February 05, 2021, 12:56:56 PM by ScottMC »

#### Marc'Antonio Alessi ##### Re: Automatic Nesting for lisp？
« Reply #53 on: February 03, 2021, 09:22:03 AM »
It works! This is my test:

#### ScottMC

• Newt
• Posts: 191 ##### Re: Automatic Nesting for lisp？
« Reply #54 on: April 30, 2021, 11:55:58 AM »
Just to ease the cad-vars.. here's the working list for "Nest":
( / a b bp e eh el ell elll ew f h k1 k2 n n2 n1 s1 s2 ss1 ss2 w x yy yn filter obj1 obj2 po eminp emaxp maxp minp )

#### ronjonp ##### Re: Automatic Nesting for lisp？
« Reply #55 on: April 30, 2021, 04:57:43 PM »
Just to ease the cad-vars.. here's the working list for "Nest":
( / a b bp e eh el ell elll ew f h k1 k2 n n2 n1 s1 s2 ss1 ss2 w x yy yn filter obj1 obj2 po eminp emaxp maxp minp )
I've tried to educate this poster a few times on localizing variables but it fell on deaf ears. Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

#### ScottMC

• Newt
• Posts: 191 ##### Re: Automatic Nesting for lisp？
« Reply #56 on: May 01, 2021, 06:46:49 PM »
I've seen others which place a combined (setq xx nil..) later in the code. Why they choose this as it could clear vars out on other working pgms...  ouch ##### Re: Automatic Nesting for lisp？
« Reply #57 on: June 10, 2021, 02:48:04 AM »
Marko Ribar, d.i.a. (graduated engineer of architecture) #### ScottMC

• Newt
• Posts: 191 ##### Re: Automatic Nesting for lisp？
« Reply #58 on: June 10, 2021, 11:00:04 AM »
Very useful tool! I use this to rearrange how items are placed on a CNC for cut. The one thing I tried was to offset each for the cut-path to ease re-arrangement but it refuses 'group' items. The other, which would sell, is asking for rotation restraint or orientation to make the wood grain be in the right direction according to the 'Picked' Rectangle. Besides my comments, what you did engineered is very helpful. Thanks ##### Re: Automatic Nesting for lisp？
« Reply #59 on: June 11, 2021, 11:29:17 AM »
I've added error handler, calculation of UNDO steps after finish and changed order of generating "l" list of (bp dx dy) so that when first pass of (main) function finishes it checks from lower left corner of main boundary for "bp"s again and not as it was from upper right to lower left... That's one thing in main routine "nesting.lsp" and I tried to make additional "nesting-new.lsp" with (process2rec) function that would try to implement checking of relation of 2 rectangles in processing nesting - all I could think of is that with this checking it's sometimes different choice of processing order of entities from list "el"... Marc's example with bigger main boundary is solvable by "nesting-new.lsp" and first DWG is somewhat better with original "nesting.lsp"... If someone has something new based on "nesting.lsp" it would be good to try to improve it, or post an opinion of what could be better and (or) relevant to this topic... Thanks for attention...

Code - Auto/Visual Lisp: [Select]
1. (defun c:nesting ( / *error* car-sort insiderec process main adoc cmde ss s i e minpt maxpt dx dy el lw bp l ll al ka kb )
2.
3.
4.   (defun *error* ( m )
5.     (if cmde
6.       (setvar 'cmdecho cmde)
7.     )
10.     )
11.     (if m
12.       (prompt m)
13.     )
14.     (princ)
15.   )
16.
17.   (defun car-sort ( lst cmp / rtn )
18.     (setq rtn (car lst))
19.     (foreach itm (cdr lst)
20.       (if (apply cmp (list itm rtn))
21.         (setq rtn itm)
22.       )
23.     )
24.     rtn
25.   )
26.
27.   (defun insiderec ( ll ur p )
28.     (and
29.       (< (car ll) (car p) (car ur))
31.     )
32.   )
33.
34.   (defun process ( el bp dx dy / e1 e2 dd1 dd2 e )
35.     (if (= 8 (logand 8 (getvar 'undoctl)))
37.     )
39.     (setq ka (1+ ka))
40.     (setq kb (1+ kb))
41.     (setq e1 (car-sort
42.                (vl-remove-if '(lambda ( x )
43.                                 (or
44.                                   (vl-some '(lambda ( y ) (insiderec (car y) (cadr y) (mapcar '+ bp (list 1e-3 1e-3)))) al)
45.                                   (vl-some '(lambda ( y ) (insiderec (car y) (cadr y) (mapcar '+ bp (list (caadr x) 0.0) (list -1e-3 1e-3)))) al)
46.                                   (vl-some '(lambda ( y ) (insiderec (car y) (cadr y) (mapcar '+ bp (list 0.0 (cadadr x)) (list 1e-3 -1e-3)))) al)
47.                                   (vl-some '(lambda ( y ) (insiderec (car y) (cadr y) (mapcar '+ bp (list (caadr x) (cadadr x)) (list -1e-3 -1e-3)))) al)
48.                                   (vl-some '(lambda ( y ) (insiderec (car y) (cadr y) (mapcar '+ bp (list (* (caadr x) 0.5) (* (cadadr x) 0.5))))) al)
49.                                   (vl-some '(lambda ( y ) (insiderec bp (mapcar '+ bp (list (caadr x) (cadadr x))) (car y))) al)
50.                                   (vl-some '(lambda ( y ) (insiderec bp (mapcar '+ bp (list (caadr x) (cadadr x))) (mapcar '+ (car y) (list (- (caadr y) (caar y)) 0.0)))) al)
54.                                   (minusp (- dx (caadr x)))
56.                                 )
57.                  ) el
59.     (setq e2 (car-sort
60.                (vl-remove-if '(lambda ( x )
61.                                 (or
62.                                   (vl-some '(lambda ( y ) (insiderec (car y) (cadr y) (mapcar '+ bp (list 1e-3 1e-3)))) al)
63.                                   (vl-some '(lambda ( y ) (insiderec (car y) (cadr y) (mapcar '+ bp (list (cadadr x) 0.0) (list -1e-3 1e-3)))) al)
64.                                   (vl-some '(lambda ( y ) (insiderec (car y) (cadr y) (mapcar '+ bp (list 0.0 (caadr x)) (list 1e-3 -1e-3)))) al)
65.                                   (vl-some '(lambda ( y ) (insiderec (car y) (cadr y) (mapcar '+ bp (list (cadadr x) (caadr x)) (list -1e-3 -1e-3)))) al)
66.                                   (vl-some '(lambda ( y ) (insiderec (car y) (cadr y) (mapcar '+ bp (list (* (cadadr x) 0.5) (* (caadr x) 0.5))))) al)
67.                                   (vl-some '(lambda ( y ) (insiderec bp (mapcar '+ bp (list (cadadr x) (caadr x))) (car y))) al)
68.                                   (vl-some '(lambda ( y ) (insiderec bp (mapcar '+ bp (list (cadadr x) (caadr x))) (mapcar '+ (car y) (list (- (caadr y) (caar y)) 0.0)))) al)
73.                                   (minusp (- dy (caadr x)))
74.                                 )
75.                  ) el
77.     (cond
78.       ( (and e1 e2)
81.         (if (< dd1 dd2)
82.           (setq e e1)
83.             (vla-rotate (vlax-ename->vla-object (car e2)) (vlax-3d-point (caddr e2)) (* 0.5 pi))
84.             (vla-move (vlax-ename->vla-object (car e2)) (vlax-3d-point '(0 0)) (vlax-3d-point (mapcar '+ '(0 0) (list (cadadr e2) 0.0))))
86.           )
87.         )
88.       )
89.       ( (and e1 (null e2))
90.         (setq e e1)
91.       )
92.       ( (and e2 (null e1))
93.         (vla-rotate (vlax-ename->vla-object (car e2)) (vlax-3d-point (caddr e2)) (* 0.5 pi))
94.         (vla-move (vlax-ename->vla-object (car e2)) (vlax-3d-point '(0 0)) (vlax-3d-point (mapcar '+ '(0 0) (list (cadadr e2) 0.0))))
96.       )
97.     )
98.     e
99.   )
100.
101.   (defun main ( el bp dx dy )
102.     (if (setq e (process el bp dx dy))
104.         (setq l (append l (list (list (mapcar '+ bp (list (caadr e) 0.0)) (- dx (caadr e)) dy))))
107.         (setq l (vl-remove-if '(lambda ( x ) (vl-some '(lambda ( y ) (equal (car x) y 1e-6)) (mapcar 'car al))) l))
108.         (if
109.           (and
110.             (not (vl-some '(lambda ( x ) (insiderec (car x) (cadr x) (mapcar '+ bp (list 1e-3 1e-3)))) (cdr al)))
111.             (not (vl-some '(lambda ( x ) (insiderec (car x) (cadr x) (mapcar '+ bp (list (caadr e) 0.0) (list -1e-3 1e-3)))) (cdr al)))
112.             (not (vl-some '(lambda ( x ) (insiderec (car x) (cadr x) (mapcar '+ bp (list 0.0 (cadadr e)) (list 1e-3 -1e-3)))) (cdr al)))
113.             (not (vl-some '(lambda ( x ) (insiderec (car x) (cadr x) (mapcar '+ bp (list (caadr e) (cadadr e)) (list -1e-3 -1e-3)))) (cdr al)))
114.             (not (vl-some '(lambda ( x ) (insiderec (car x) (cadr x) (mapcar '+ bp (list (* (caadr e) 0.5) (* (cadadr e) 0.5))))) (cdr al)))
115.             (not (vl-some '(lambda ( x ) (insiderec bp (mapcar '+ bp (list (caadr e) (cadadr e))) (car x))) (cdr al)))
116.             (not (vl-some '(lambda ( x ) (insiderec bp (mapcar '+ bp (list (caadr e) (cadadr e))) (mapcar '+ (car x) (list (- (caadr x) (caar x)) 0.0)))) (cdr al)))
120.           )
121.             (vla-move (vlax-ename->vla-object (car e)) (vlax-3d-point (caddr e)) (vlax-3d-point bp))
122.             (setq el (vl-remove-if '(lambda ( x ) (eq (car x) (car e))) el))
123.             (cond
124.               ( (process el (mapcar '+ bp (list (caadr e) 0.0)) (- dx (caadr e)) dy)
125.                 (vl-cmdf "_.undo" "_b")
126.                 (setq kb (1- kb))
127.                 (main el (mapcar '+ bp (list (caadr e) 0.0)) (- dx (caadr e)) dy)
128.               )
130.                 (vl-cmdf "_.undo" "_b")
131.                 (setq kb (1- kb))
133.               )
135.                 (vl-cmdf "_.undo" "_b")
136.                 (setq kb (1- kb))
138.               )
139.               ( t el )
140.             )
141.           )
142.           el
143.         )
144.       )
145.       el
146.     )
147.   )
148.
149.   (if (= 8 (logand 8 (getvar 'undoctl)))
151.   )
152.   (setq cmde (getvar 'cmdecho))
153.   (setvar 'cmdecho 0)
154.   (setq ka 0)
155.   (setq kb 0)
156.   (if
157.     (and
158.       (not (prompt "\nSelect parts for nesting..."))
159.       (setq ss (ssget "_:L"))
160.       (not (prompt "\nPick boundary RECTANGLE..."))
161.       (setq s (ssget "_+.:E:S" (list '(0 . "LWPOLYLINE") '(90 . 4) '(-4 . "&=") '(70 . 1) '(-4 . "<not") '(-4 . "<>") '(42 . 0.0) '(-4 . "not>"))))
162.     )
163.       (repeat (setq i (sslength ss))
164.         (setq e (ssname ss (setq i (1- i))))
165.         (vla-getboundingbox (vlax-ename->vla-object e) 'minpt 'maxpt)
166.         (mapcar 'set '(minpt maxpt) (mapcar 'safearray-value (list minpt maxpt)))
167.         (setq dx (- (car maxpt) (car minpt)))
169.         (setq el (cons (list e (list dx dy) minpt) el))
170.       )
171.       (setq lw (ssname s 0))
172.       (vla-getboundingbox (vlax-ename->vla-object lw) 'minpt 'maxpt)
173.       (mapcar 'set '(minpt maxpt) (mapcar 'safearray-value (list minpt maxpt)))
174.       (setq dx (- (car maxpt) (car minpt)))
176.       (setq bp minpt)
177.       (setq el (main el bp dx dy))
178.       (while (and el (setq ll (car l)))
179.         (setq l (cdr l))
180.         (mapcar 'set '(bp dx dy) ll)
181.         (setq el (main el bp dx dy))
182.       )
183.       (prompt "\nType \"UNDO\" ") (princ ka) (prompt " for back if you are using AutoCAD...")
184.       (prompt "\nType \"UNDO\" ") (princ kb) (prompt " for back if you are using BricsCAD...")
185.     )
186.   )
187.   (*error* nil)
188. )
189.
« Last Edit: June 12, 2021, 08:10:24 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture) 