Author Topic: Automatic Nesting for lisp?  (Read 26891 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

roy_043

  • Water Moccasin
  • Posts: 1895
  • BricsCAD 18
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: 112
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)))
  20.     (setq eh (- (cadr emaxp) (cadr 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)))
  28.        (setq eh (- (cadr emaxp) (cadr eminp)))
  29.       )
  30.     )
  31.     (setq el (cons (list eminp ew eh s1) el))
  32.   )
  33.   (setq el (vl-sort el
  34.                     '(lambda (a b)
  35.                        (if (equal (caddr a) (caddr b) 1e-3)
  36.                          (< (cadr a) (cadr b))
  37.                          (< (caddr a) (caddr 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)))
  51.     (setq h (- (cadr maxp) (cadr minp)))
  52.     (setq x nil)
  53.     (setq y nil)
  54.     (setq yn nil)
  55.     (setq ell nil)
  56.     (setq elll nil)
  57.     (while
  58.       (and
  59.         (car el)
  60.         (cond
  61.           ((null x) (setq x 0.0) (setq y 0.0) (setq f x))
  62.           ((> (+ x (cadar el)) w)
  63.            (setq x 0.0)
  64.            (foreach e elll (setq ell (vl-remove e ell)))
  65.            (setq elll ell)
  66.            (setq y (+ (cadr (car (reverse ell))) (caddr (caddr (car (reverse ell))))))
  67.            (vl-some '(lambda (e) (cond ((< (cadar el) (+ (car e) 1e-3)) (setq yn (+ (cadr e) (caddr (caddr e)))))))
  68.                     (reverse ell)
  69.            )
  70.            (cond ((> yn y) (setq y yn)))
  71.            (setq f x)
  72.           )
  73.           (t
  74.            (if
  75.              (not
  76.                (vl-some '(lambda (e) (cond ((< (+ x (cadar el)) (+ (car e) 1e-3)) (setq yn (+ (cadr e) (caddr (caddr e)))))))
  77.                         (reverse ell)
  78.                )
  79.              )
  80.               (vl-some
  81.                 '(lambda (e)
  82.                    (cond ((or (< (+ x (cadar el)) (car e)) (< (+ x 1e-3) (car e))) (setq yn (+ (cadr e) (caddr (caddr e))))))
  83.                  )
  84.                 (vl-sort ell '(lambda (a b) (> (car a) (car b))))
  85.               )
  86.            )
  87.            (cond ((> yn y) (setq y yn)))
  88.            (setq f x)
  89.           )
  90.         )
  91.         (< f w)
  92.         (or (< (+ y (caddar el)) h) (equal (+ y (caddar el)) h 1e-3))
  93.       )
  94.        (if (= x 0.0)
  95.          (setq bp (list (car minp) (+ y (cadr minp)) 0.0))
  96.          (setq bp (list (+ x (car minp)) (+ y (cadr minp)) 0.0))
  97.        )
  98.        (setq x (+ x (cadar el)))
  99.        (vla-move (vlax-ename->vla-object (cadddr (car el))) (vlax-3d-point (caar el)) (vlax-3d-point bp))
  100.        (setq ell (cons (list x y (car el)) ell))
  101.        (setq el (cdr el))
  102.     )
  103.   )
  104.   (princ)
  105. )





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: 112
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!!  :idiot2:
« Last Edit: February 05, 2021, 12:56:56 PM by ScottMC »


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

  • Needs a day job
  • Posts: 7526
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.  :roll:

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

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

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

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
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.     )
  8.     (if adoc
  9.       (vla-endundomark adoc)
  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))
  30.       (< (cadr ll) (cadr p) (cadr ur))
  31.     )
  32.   )
  33.  
  34.   (defun process ( el bp dx dy / e1 e2 dd1 dd2 e )
  35.     (if (= 8 (logand 8 (getvar 'undoctl)))
  36.       (vla-endundomark adoc)
  37.     )
  38.     (vla-startundomark adoc)
  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)
  51.                                   (vl-some '(lambda ( y ) (insiderec bp (mapcar '+ bp (list (caadr x) (cadadr x))) (cadr y))) al)
  52.                                   (vl-some '(lambda ( y ) (insiderec bp (mapcar '+ bp (list (caadr x) (cadadr x))) (mapcar '+ (car y) (list 0.0 (- (cadadr y) (cadar y)))))) al)
  53.                                   (vl-some '(lambda ( y ) (insiderec bp (mapcar '+ bp (list (caadr x) (cadadr x))) (mapcar '+ (car y) (list (* (- (caadr y) (caar y)) 0.5) (* (- (cadadr y) (cadar y)) 0.5))))) al)
  54.                                   (minusp (- dx (caadr x)))
  55.                                   (minusp (- dy (cadadr x)))
  56.                                 )
  57.                  ) el
  58.                ) '(lambda ( a b ) (< (min (- dx (caadr a)) (- dy (cadadr a))) (min (- dx (caadr b)) (- dy (cadadr b)))))))
  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)
  69.                                   (vl-some '(lambda ( y ) (insiderec bp (mapcar '+ bp (list (cadadr x) (caadr x))) (cadr y))) al)
  70.                                   (vl-some '(lambda ( y ) (insiderec bp (mapcar '+ bp (list (cadadr x) (caadr x))) (mapcar '+ (car y) (list 0.0 (- (cadadr y) (cadar y)))))) al)
  71.                                   (vl-some '(lambda ( y ) (insiderec bp (mapcar '+ bp (list (cadadr x) (caadr x))) (mapcar '+ (car y) (list (* (- (caadr y) (caar y)) 0.5) (* (- (cadadr y) (cadar y)) 0.5))))) al)
  72.                                   (minusp (- dx (cadadr x)))
  73.                                   (minusp (- dy (caadr x)))
  74.                                 )
  75.                  ) el
  76.                ) '(lambda ( a b ) (< (min (- dx (cadadr a)) (- dy (caadr a))) (min (- dx (cadadr b)) (- dy (caadr b)))))))
  77.     (cond
  78.       ( (and e1 e2)
  79.         (setq dd1 (min (- dx (caadr e1)) (- dy (cadadr e1))))
  80.         (setq dd2 (min (- dx (cadadr e2)) (- dy (caadr e2))))
  81.         (if (< dd1 dd2)
  82.           (setq e e1)
  83.           (progn
  84.             (vla-rotate (vlax-ename->vla-object (car e2)) (vlax-3d-point (caddr e2)) (* 0.5 pi))
  85.             (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.             (setq e (subst (list (cadadr e2) (caadr e2)) (cadr e2) e2))
  87.           )
  88.         )
  89.       )
  90.       ( (and e1 (null e2))
  91.         (setq e e1)
  92.       )
  93.       ( (and e2 (null e1))
  94.         (vla-rotate (vlax-ename->vla-object (car e2)) (vlax-3d-point (caddr e2)) (* 0.5 pi))
  95.         (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.         (setq e (subst (list (cadadr e2) (caadr e2)) (cadr e2) e2))
  97.       )
  98.     )
  99.     e
  100.   )
  101.  
  102.   (defun main ( el bp dx dy )
  103.     (if (setq e (process el bp dx dy))
  104.       (progn
  105.         (setq al (cons (list bp (mapcar '+ bp (list (caadr e) (cadadr e)))) al))
  106.         (setq l (append l (list (list (mapcar '+ bp (list (caadr e) 0.0)) (- dx (caadr e)) dy))))
  107.         (setq l (append l (list (list (mapcar '+ bp (list 0.0 (cadadr e))) dx (- dy (cadadr e))))))
  108.         (setq l (append l (list (list (mapcar '+ bp (list (caadr e) (cadadr e))) (- dx (caadr e)) (- dy (cadadr e))))))
  109.         (setq l (vl-remove-if '(lambda ( x ) (vl-some '(lambda ( y ) (equal (car x) y 1e-6)) (mapcar 'car al))) l))
  110.         (if
  111.           (and
  112.             (not (vl-some '(lambda ( x ) (insiderec (car x) (cadr x) (mapcar '+ bp (list 1e-3 1e-3)))) (cdr al)))
  113.             (not (vl-some '(lambda ( x ) (insiderec (car x) (cadr x) (mapcar '+ bp (list (caadr e) 0.0) (list -1e-3 1e-3)))) (cdr al)))
  114.             (not (vl-some '(lambda ( x ) (insiderec (car x) (cadr x) (mapcar '+ bp (list 0.0 (cadadr e)) (list 1e-3 -1e-3)))) (cdr al)))
  115.             (not (vl-some '(lambda ( x ) (insiderec (car x) (cadr x) (mapcar '+ bp (list (caadr e) (cadadr e)) (list -1e-3 -1e-3)))) (cdr al)))
  116.             (not (vl-some '(lambda ( x ) (insiderec (car x) (cadr x) (mapcar '+ bp (list (* (caadr e) 0.5) (* (cadadr e) 0.5))))) (cdr al)))
  117.             (not (vl-some '(lambda ( x ) (insiderec bp (mapcar '+ bp (list (caadr e) (cadadr e))) (car x))) (cdr al)))
  118.             (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)))
  119.             (not (vl-some '(lambda ( x ) (insiderec bp (mapcar '+ bp (list (caadr e) (cadadr e))) (cadr x))) (cdr al)))
  120.             (not (vl-some '(lambda ( x ) (insiderec bp (mapcar '+ bp (list (caadr e) (cadadr e))) (mapcar '+ (car x) (list 0.0 (- (cadadr x) (cadar x)))))) (cdr al)))
  121.             (not (vl-some '(lambda ( x ) (insiderec bp (mapcar '+ bp (list (caadr e) (cadadr e))) (mapcar '+ (car x) (list (* (- (caadr x) (caar x)) 0.5) (* (- (cadadr x) (cadar x)) 0.5))))) (cdr al)))
  122.           )
  123.           (progn
  124.             (vla-move (vlax-ename->vla-object (car e)) (vlax-3d-point (caddr e)) (vlax-3d-point bp))
  125.             (setq el (vl-remove-if '(lambda ( x ) (eq (car x) (car e))) el))
  126.             (cond
  127.               ( (process el (mapcar '+ bp (list (caadr e) 0.0)) (- dx (caadr e)) dy)
  128.                 (vl-cmdf "_.undo" "_b")
  129.                 (setq kb (1- kb))
  130.                 (main el (mapcar '+ bp (list (caadr e) 0.0)) (- dx (caadr e)) dy)
  131.               )
  132.               ( (process el (mapcar '+ bp (list 0.0 (cadadr e))) dx (- dy (cadadr e)))
  133.                 (vl-cmdf "_.undo" "_b")
  134.                 (setq kb (1- kb))
  135.                 (main el (mapcar '+ bp (list 0.0 (cadadr e))) dx (- dy (cadadr e)))
  136.               )
  137.               ( (process el (mapcar '+ bp (list (caadr e) (cadadr e))) (- dx (caadr e)) (- dy (cadadr e)))
  138.                 (vl-cmdf "_.undo" "_b")
  139.                 (setq kb (1- kb))
  140.                 (main el (mapcar '+ bp (list (caadr e) (cadadr e))) (- dx (caadr e)) (- dy (cadadr e)))
  141.               )
  142.               ( t el )
  143.             )
  144.           )
  145.           el
  146.         )
  147.       )
  148.       el
  149.     )
  150.   )
  151.  
  152.   (if (= 8 (logand 8 (getvar 'undoctl)))
  153.     (vla-endundomark adoc)
  154.   )
  155.   (setq cmde (getvar 'cmdecho))
  156.   (setvar 'cmdecho 0)
  157.   (setq ka 0)
  158.   (setq kb 0)
  159.   (if
  160.     (and
  161.       (not (prompt "\nSelect parts for nesting..."))
  162.       (setq ss (ssget "_:L"))
  163.       (not (prompt "\nPick boundary RECTANGLE..."))
  164.       (setq s (ssget "_+.:E:S" (list '(0 . "LWPOLYLINE") '(90 . 4) '(-4 . "&=") '(70 . 1) '(-4 . "<not") '(-4 . "<>") '(42 . 0.0) '(-4 . "not>"))))
  165.     )
  166.     (progn
  167.       (repeat (setq i (sslength ss))
  168.         (setq e (ssname ss (setq i (1- i))))
  169.         (vla-getboundingbox (vlax-ename->vla-object e) 'minpt 'maxpt)
  170.         (mapcar 'set '(minpt maxpt) (mapcar 'safearray-value (list minpt maxpt)))
  171.         (setq dx (- (car maxpt) (car minpt)))
  172.         (setq dy (- (cadr maxpt) (cadr minpt)))
  173.         (setq el (cons (list e (list dx dy) minpt) el))
  174.       )
  175.       (setq lw (ssname s 0))
  176.       (vla-getboundingbox (vlax-ename->vla-object lw) 'minpt 'maxpt)
  177.       (mapcar 'set '(minpt maxpt) (mapcar 'safearray-value (list minpt maxpt)))
  178.       (setq dx (- (car maxpt) (car minpt)))
  179.       (setq dy (- (cadr maxpt) (cadr minpt)))
  180.       (setq bp minpt)
  181.       (setq el (main el bp dx dy))
  182.       (while (and el (setq ll (car l)))
  183.         (setq l (cdr l))
  184.         (mapcar 'set '(bp dx dy) ll)
  185.         (setq el (main el bp dx dy))
  186.       )
  187.       (prompt "\nType \"UNDO\" ") (princ ka) (prompt " for back if you are using AutoCAD...")
  188.       (prompt "\nType \"UNDO\" ") (princ kb) (prompt " for back if you are using BricsCAD...")
  189.     )
  190.   )
  191.   (*error* nil)
  192. )
  193.  
« Last Edit: June 12, 2021, 08:10:24 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube