Create Layout from a grid in model space

October 26, 2022

Hi, looking for a solution to automatically create layouts starting from a grid in model space I found the PlotDWGarr.vlx lisp (here: https://www.cadforum.cz/en/download.asp?fileID=1172).

I use the associated lisp LayDWGarr.

I also saw a tutorial on how it works (here: https://www.youtube.com/watch?v=nNiIVZvqXLk).

It seems to me that I have done everything correctly, the layout template (PlotArrTemplate), the succession of entry points etc. but the layouts that are generated always point only to box A01.

I doubt it's the lisp that's malfunctioning, but I don't understand what I could have done wrong.

What could be wrong with my file?

Do you know of an alternate lisp that performs the operation I am trying to do?

Thank you in advance

GRIGLIA A3 A-O 1-30.dwgFetching info...

October 27, 2022

I have something but its not free but very cheap, it looks at the rectangs and makes a layout to match. It would need some custom changes to suit your needs as grids. The obvious 1st step is making the rectangs.

I have made 40+ layouts in one go.

Edited October 28, 2022 by BIGAL

October 27, 2022

If you can create the layouts from your LISP but just need to adjust the rectangular view this might be a 'fix', will only really work for orthogonal rectangles.

Double click in the view port, run this LISP, select the rectangle area to be shown in that view port.

;;https://forums.autodesk.com/t5/autocad-forum/having-trouble-with-the-lisp-that-zooms-a-rectangle-that-fits-in/td-p/9378532
(defun c:zvprect ( / a b e o)  ;; I renamed this to fit my brain: 'z' - zoom, 'vp' - viewport, 'rect' - rectangle
  (if (setq e (car (entsel "\nSelect Rectangle : ")))
    (progn
      (setq o (vlax-ename->vla-object e))
      (vlax-invoke-method o 'GetBoundingBox 'a 'b)
      (setq a (vlax-safearray->list a)
     b (vlax-safearray->list b)
      )
      (vl-cmdf "_.zoom" a b)
      )
    )
  (princ)
)

October 27, 2022

I solved! obviously I was wrong ...
Simply the layout (PlotArrTemplate) must not have the view locked!
LayDWGarr works perfectly, highly recommended!

Now I have to look for a "layout manager", (rename ... navigate ...) if you have one to recommend thank you

October 27, 2022

On 10/27/2022 at 10:24 AM, itacad said:

Now I have to look for a "layout manager", (rename ... navigate ...) if you have one to recommend thank you

Expand

http://www.lee-mac.com/tabsort.html

October 27, 2022

How did I not think he didn't have a solution!
My faith in Lee Mac is still not strong enough!

Thanks!

December 20, 2023

On 10/27/2022 at 12:20 AM, BIGAL said:

I have something but its not free but very cheap, it looks at the rectangs and makes a layout to match. It would need some custom changes to suit your needs as grids. The obvious 1st step is making the rectangs.

I have made 40+ layouts in one go.

Expand

Where can I get the lisp? Thank you!

April 8

@Steven P nice...

somewhat old but very useful...

I added a few small things that make it a little more convenient for me, and maybe for others too...

Great lisp!!

;;https://forums.autodesk.com/t5/autocad-forum/having-trouble-with-the-lisp-that-zooms-a-rectangle-that-fits-in/td-p/9378532
;; draw rectangle aroud the viewport,copy the rectangle to model space where you need to print.
;; for 1:1 (1:1000m) don't scale. for 1:1250 scale 1.25 etc' 
(defun c:zvprect1 ( / *error* trap1 olderr a b e o)  ;; I renamed this to fit my brain: 'z' - zoom, 'vp' - viewport, 'rect' - rectangle

(defun trap1 ( msg )
  (command "._PSPACE")
  (setq *error* olderr); restore *error* symbol
  (princ)
)

(setq olderr *error*); assign current function defintion held by the *error* symbol to a local variable - olderr
(setq *error* trap1); pointing the *error* symbol to new function definition - trap1

  (command "._MSPACE")
  (if (setq e (car (entsel "\nSelect Rectangle : ")))
    (progn
      (setq o (vlax-ename->vla-object e))
      (vlax-invoke-method o 'GetBoundingBox 'a 'b)
      (setq a (vlax-safearray->list a))
      (setq b (vlax-safearray->list b))
      (vl-cmdf "_.zoom" a b)
    );progn
  );if
  (command "._PSPACE")
  (setq *error* olderr); restore *error* symbol
  (princ)
)

Edited April 8 by aridzv

April 8

Just a comment I have 3 ways to make layouts matching rectangs, walk along a p/line, pick a point and make horizontal.

Rectangs can be rotated and that is reflected as a twisted view in a layout, viewport.

As I said real cheap as I normally have to customise for each end user, just posting code would mean repeated questions here while people try to get it to work. I normally include matching plot code as well for free.

April 9

On 4/8/2025 at 11:51 PM, BIGAL said:

Just a comment I have 3 ways to make layouts matching rectangs, walk along a p/line, pick a point and make horizontal.

Rectangs can be rotated and that is reflected as a twisted view in a layout, viewport.

As I said real cheap as I normally have to customise for each end user, just posting code would mean repeated questions here while people try to get it to work. I normally include matching plot code as well for free.

Expand

I have seen your reply a bunch Alan, but I don't see a way to contact you to purchase the routine that you put together for making PS viewports from Modelspace which has come up up so many times lately. The website link in your profile doesn't load anything (at least on my end). I would definitely buy a license and possibly for others that I work with, but they can barely use ACAD as it is.. (LOL) What is the best way for us to purchase this tool?

Thank you for developing a solution.

April 9

For an example of the insanity I am trying to combat with this tool. I have a senior engineer that when I talk about new commands and variables, he never understands and the info enters and leaves his mind instantly. But for some reason, he listened to and grabbed on to VPROTATEASSOC and has ever since set all of drawing with rotated viewports in Paperspace with this variable, thus thinking that he has solved the issue without realizing text and dimensions in model space. I have done many lunch and learn lessons about using a temporary UCS and how to align the text that way. And I have done more on DIVIEW Twist and aligning the text. But this does not seem to sink in. Getting this guy's projects to work has been a literal nightmare when viewports need to be rotated. So I will be more than happy to buy your program Alan.

April 9

Hi.

I need some help with the lisp below.

I managed to create the layouts but I can't get the viewports to zoom to the rectangle frame.

I attched here a sample drawing "rectolayout.dwg" and the code.

1. open the drawing and load the lisp.

2. go to the base layout tab and run the lisp (I use the "A-4" tab,the rectangles are from there so it should give a scale of 1:1).

3. the lisp move to model space,select the rectangles (can select only 2 for the example).

4. set the integer for suffix.

at that point the layout tabs are created but not zoom properly.

any help will be wellcome.

Thanks,

aridzv.


;;;;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/copy-first-layout-multiple-times-and-number-incrementally/td-p/7030955;;;
(defun c:genlayouts-2 (/ trap1 olderr baselay tablist layname cnt entrec objrec a b nn adoc curpos curtab i n)

(defun trap1 ( msg )
  (setq *error* olderr); restore *error* symbol
  (princ)
)

(setq olderr *error*); assign current function defintion held by the *error* symbol to a local variable - olderr
(setq *error* trap1); pointing the *error* symbol to new function definition - trap1


(setq baselay (getvar 'ctab));;store base layout
(setvar "tilemode" 1);;move to mode space

(if (setq ssrect (ssget '((0 . "LWPOLYLINE") (70 . 1) (90 . 4))));;;;;;;;;;main if
 (progn
   (setq n (sslength ssrect))
   (setvar 'ctab baselay);;back to base layout
   (and (= 0 (getvar 'tilemode))
      (setq i (getint "\nEnter begining integer for suffix: "))
      (setq curtab (getvar 'ctab))
      ;(setq n (getint "\nHow many copies of this tab: "))
      (repeat n
        (if (not(member (strcat curtab "." (itoa (+ (1- n) i))) (layoutlist)))
          (progn 
           (command "._layout" "_copy" "" (strcat curtab "." (itoa (+ (1- n) i))));;create new layout tab
           (setq tablist (cons (strcat curtab "." (itoa (+ (1- n) i))) tablist))
           (setvar 'ctab (strcat curtab "." (itoa (+ (1- n) i))));move to new layout tab
          );progn
        );if
        (setq i (1- i))
      );repeat
    );and
 );end progn main
);;;;;;;;;;end main if

;(setvar "tilemode" 0)

(setq nn (sslength ssrect))
(setq cnt (- (sslength ssrect) 1))
(repeat nn
  (setq layname (nth (1- nn) tablist))
  (setvar 'ctab layname)
  (setvar "tilemode" 1)
;;;;;;;;;;;;;;by Steven P https://www.cadtutor.net/forum/topic/76216-create-layout-from-a-grid-in-model-space/;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;create viewport from rectangle in current layout;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
           (if (setq entrec (ssname ssrect cnt));get rectangle ename
             (progn
               (setq objrec (vlax-ename->vla-object entrec));Transforms entrec to a VLA-object
               (vlax-invoke-method objrec 'GetBoundingBox 'a 'b); get max and min points of the rectangle as safe array
               (setq a (vlax-safearray->list a));convert a from safe array to list
               (setq b (vlax-safearray->list b));convert b from safe array to list
               (vl-cmdf "_.zoom" a b)
             );progn
             (alert "no ent")
           );if
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (setq cnt (1- cnt)) 
  (setvar "tilemode" 0)  
);repeat

;(princ tablist)
(TabSort)
(setq *error* olderr); restore *error* symbol
(princ)
);defun 


;;;;https://www.cadtutor.net/forum/topic/10087-re-ordering-layout-tabs/;;;;;
;; --------------------------------------------------------------------------- 
;; Function: tabsort 
;; Purpose : sort Tabs by the prefix then the first numbers found 
;; AUTHOR  Charles Alan Butler @ TheSwamp.org
;; --------------------------------------------------------------------------- 

;; Last Update 03/01/2006  CAB
(defun TabSort (/ cnt doc lay)
 (vl-load-com)

 ;; --------------------------------------------------------------------------- 
 ;; Function: Num_sort 
 ;; Purpose : sort list of strings by the prefix then the first numbers found 
 ;; AUTHOR  Charles Alan Butler @ TheSwamp.org
 ;; Params  : tablst:    list of strings to sort
 ;; Returns : sorted list
 ;; --------------------------------------------------------------------------- 
 (defun Num_Sort (tablst / tab ptr len loop tmp tmp2 sub lst)

   (defun vl-sort-it (lst func)
     (mapcar '(lambda (x) (nth x lst)) (vl-sort-i lst func))
   )

   (defun sort2 (tmp2 sub)
     (setq tmp2 (append
                  (vl-sort-it sub '(lambda (e1 e2) (< (cadr e1) (cadr e2))))
                  tmp2
                )
     )
   )

   ;;  convert to a list (string) -> (prefix num string)
   (foreach tab tablst
     (setq ptr  1
           len  (strlen tab)
           loop t
     )
     (while loop
       (cond
         ((wcmatch "0123456789" (strcat "*" (substr tab ptr 1) "*"))
          (setq tmp  (cons (list (substr tab 1 (1- ptr))
                                 (atof (substr tab ptr))
                                 tab
                           )
                           tmp
                     )
                loop nil
          )
         )
         ((> (setq ptr (1+ ptr)) len)
          ;;  no number in string
          (setq tmp  (cons (list tab nil tab) tmp)
                loop nil
          )
         )
       )                     ; end cond stmt
     )
   )

   ;;  sort on the prefix
   (setq tmp (vl-sort-it tmp '(lambda (e1 e2) (< (car e1) (car e2)))))

   ;; Do a number sort on each group of matching prefex
   (setq idx (length tmp))
   (while (> (setq idx (1- idx)) -1)
     (cond
       ((not sub)
        (setq sub (List (nth idx tmp))
              str (car (nth idx tmp))
        )
       )
       ((= (car (nth idx tmp)) str) ; still in the group
        (setq sub (cons (nth idx tmp) sub))
       )
     )                       ; end cond stmt

     (if (= idx 0)           ; end of list
       (progn
         (setq tmp2 (sort2 tmp2 sub))
         (if (/= (car (nth idx tmp)) str)
           (setq tmp2 (append (list (nth idx tmp)) tmp2))
         )
         (setq str (car (nth idx tmp)))
       )
     )

     (if (/= (car (nth idx tmp)) str)
       ;; next group, so sort previous group
       (setq tmp2 (sort2 tmp2 sub)
             sub  (list (nth idx tmp))
             str  (car (nth idx tmp))
       )
     )
   )                         ; end while
   (setq lst (mapcar 'caddr tmp2))
   (princ)
   lst
 )                           ; end defun
 ;;==========================================================================

 (setq cnt 1
       doc (vla-get-activedocument (vlax-get-acad-object))
 )
 (foreach lay (num_sort (vl-remove "Model" (layoutlist)))
   (vla-put-taborder (vla-item (vla-get-layouts doc) lay) cnt)
   (setq cnt (1+ cnt))
 )
 (princ)
)                           ; end defun
(prompt "\nTabSort loaded, enter TabSort to run.")
(princ)

rectolayout.dwgFetching info...

Edited April 9 by aridzv

April 9

Hey @aridzv,

Try this:

;;;;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/copy-first-layout-multiple-times-and-number-incrementally/td-p/7030955;;;
(defun c:genlayouts-2 (/ trap1 olderr baselay tablist layname cnt entrec objrec a b nn adoc curpos curtab i n)

(defun trap1 ( msg )
  (setq *error* olderr); restore *error* symbol
  (princ)
)

(setq olderr *error*); assign current function defintion held by the *error* symbol to a local variable - olderr
(setq *error* trap1); pointing the *error* symbol to new function definition - trap1


(setq baselay (getvar 'ctab));;store base layout
(setvar "tilemode" 1);;move to mode space

(if (setq ssrect (ssget '((0 . "LWPOLYLINE") (70 . 1) (90 . 4))));;;;;;;;;;main if
 (progn
   (setq n (sslength ssrect))
   (setvar 'ctab baselay);;back to base layout
   (and (= 0 (getvar 'tilemode))
      (setq i (getint "\nEnter begining integer for suffix: "))
      (setq curtab (getvar 'ctab))
      ;(setq n (getint "\nHow many copies of this tab: "))
      (repeat n
        (if (not(member (strcat curtab "." (itoa (+ (1- n) i))) (layoutlist)))
          (progn 
           (command "._layout" "_copy" "" (strcat curtab "." (itoa (+ (1- n) i))));;create new layout tab
           (setq tablist (cons (strcat curtab "." (itoa (+ (1- n) i))) tablist))
           (setvar 'ctab (strcat curtab "." (itoa (+ (1- n) i))));move to new layout tab
          );progn
        );if
        (setq i (1- i))
      );repeat
    );and
 );end progn main
);;;;;;;;;;end main if

(setvar "tilemode" 0)
(TabSort)
(setq nn (sslength ssrect))
(setq cnt (- (sslength ssrect) 1))
(repeat nn
  (setq layname (nth (1- nn) tablist))
  (setvar 'ctab layname)
;;;  (setvar "tilemode" 0)
  (command "MSPACE")
;;;;;;;;;;;;;;by Steven P https://www.cadtutor.net/forum/topic/76216-create-layout-from-a-grid-in-model-space/;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;create viewport from rectangle in current layout;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
           (if (setq entrec (ssname ssrect cnt));get rectangle ename
             (progn
               (setq objrec (vlax-ename->vla-object entrec));Transforms entrec to a VLA-object
               (vlax-invoke-method objrec 'GetBoundingBox 'a 'b); get max and min points of the rectangle as safe array
               (setq a (vlax-safearray->list a));convert a from safe array to list
               (setq b (vlax-safearray->list b));convert b from safe array to list
               (vl-cmdf "_.zoom" a b)
	       (command "PSPACE")
             );progn
             (alert "no ent")
           );if
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (setq cnt (1- cnt))
  (setq nn (1- nn))
;;;  (setvar "tilemode" 0)  
);repeat

;(princ tablist)
;;;(TabSort)
(setq *error* olderr); restore *error* symbol
(princ)
);defun 


;;;;https://www.cadtutor.net/forum/topic/10087-re-ordering-layout-tabs/;;;;;
;; --------------------------------------------------------------------------- 
;; Function: tabsort 
;; Purpose : sort Tabs by the prefix then the first numbers found 
;; AUTHOR  Charles Alan Butler @ TheSwamp.org
;; --------------------------------------------------------------------------- 

;; Last Update 03/01/2006  CAB
(defun TabSort (/ cnt doc lay)
 (vl-load-com)

 ;; --------------------------------------------------------------------------- 
 ;; Function: Num_sort 
 ;; Purpose : sort list of strings by the prefix then the first numbers found 
 ;; AUTHOR  Charles Alan Butler @ TheSwamp.org
 ;; Params  : tablst:    list of strings to sort
 ;; Returns : sorted list
 ;; --------------------------------------------------------------------------- 
 (defun Num_Sort (tablst / tab ptr len loop tmp tmp2 sub lst)

   (defun vl-sort-it (lst func)
     (mapcar '(lambda (x) (nth x lst)) (vl-sort-i lst func))
   )

   (defun sort2 (tmp2 sub)
     (setq tmp2 (append
                  (vl-sort-it sub '(lambda (e1 e2) (< (cadr e1) (cadr e2))))
                  tmp2
                )
     )
   )

   ;;  convert to a list (string) -> (prefix num string)
   (foreach tab tablst
     (setq ptr  1
           len  (strlen tab)
           loop t
     )
     (while loop
       (cond
         ((wcmatch "0123456789" (strcat "*" (substr tab ptr 1) "*"))
          (setq tmp  (cons (list (substr tab 1 (1- ptr))
                                 (atof (substr tab ptr))
                                 tab
                           )
                           tmp
                     )
                loop nil
          )
         )
         ((> (setq ptr (1+ ptr)) len)
          ;;  no number in string
          (setq tmp  (cons (list tab nil tab) tmp)
                loop nil
          )
         )
       )                     ; end cond stmt
     )
   )

   ;;  sort on the prefix
   (setq tmp (vl-sort-it tmp '(lambda (e1 e2) (< (car e1) (car e2)))))

   ;; Do a number sort on each group of matching prefex
   (setq idx (length tmp))
   (while (> (setq idx (1- idx)) -1)
     (cond
       ((not sub)
        (setq sub (List (nth idx tmp))
              str (car (nth idx tmp))
        )
       )
       ((= (car (nth idx tmp)) str) ; still in the group
        (setq sub (cons (nth idx tmp) sub))
       )
     )                       ; end cond stmt

     (if (= idx 0)           ; end of list
       (progn
         (setq tmp2 (sort2 tmp2 sub))
         (if (/= (car (nth idx tmp)) str)
           (setq tmp2 (append (list (nth idx tmp)) tmp2))
         )
         (setq str (car (nth idx tmp)))
       )
     )

     (if (/= (car (nth idx tmp)) str)
       ;; next group, so sort previous group
       (setq tmp2 (sort2 tmp2 sub)
             sub  (list (nth idx tmp))
             str  (car (nth idx tmp))
       )
     )
   )                         ; end while
   (setq lst (mapcar 'caddr tmp2))
   (princ)
   lst
 )                           ; end defun
 ;;==========================================================================

 (setq cnt 1
       doc (vla-get-activedocument (vlax-get-acad-object))
 )
 (foreach lay (num_sort (vl-remove "Model" (layoutlist)))
   (vla-put-taborder (vla-item (vla-get-layouts doc) lay) cnt)
   (setq cnt (1+ cnt))
 )
 (princ)
)                           ; end defun
(prompt "\nTabSort loaded, enter TabSort to run.")
(princ)

See the attached video. I left only A-0 layout.

April 9

@Saxlle thanks!!

yes,

I didn't move to model space before the zoom....

here is the final lisp I'm going to use with 2 additions:

1. make sure the lisp start in a layout tab.

2. create new layout tab if that tab name already exist.


;;;;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/copy-first-layout-multiple-times-and-number-incrementally/td-p/7030955;;;
(defun c:vpfrectngl-multi (/ trap1 olderr baselay tablist layname cnt entrec objrec a b nn adoc curpos curtab lytname lytcnt i n)

(defun trap1 (errmsg)
  (setq *error* olderr); restore *error* symbol
  (princ)
)

(setq olderr *error*); assign current function defintion held by the *error* symbol to a local variable - olderr
(setq *error* trap1); pointing the *error* symbol to new function definition - trap1


(if (= (getvar "tilemode") 0);if1 in layout
 (progn;progn-1 
   (setq baselay (getvar 'ctab));;store base layout
   (setvar "tilemode" 1);;move to mode space

   (if (setq ssrect (ssget '((0 . "LWPOLYLINE") (70 . 1) (90 . 4))));;;;;;;;;;if2
    (progn ;progn-2
      (setq n (sslength ssrect))
      (setvar 'ctab baselay);;back to base layout
      (and (= 0 (getvar 'tilemode))
         (setq i (getint "\nEnter begining integer for suffix: "))
         (setq curtab (getvar 'ctab))
         (repeat n 
           (setq lytcnt 1)
           (setq lytname (strcat curtab "." (itoa (+ (1- n) i))))

             (while (member lytname (layoutlist));while-1 if layout tab name exist add 1 to suffix until it is a new name  
                 (setq lytname (strcat curtab "." (itoa (+ (1- n) (+ i lytcnt)))))
                 (setq lytcnt (1+ lytcnt))
             );while-1

              (command "._layout" "_copy" "" lytname) ;(strcat curtab "." (itoa (+ (1- n) i))));;create new layout tab
              (setq tablist (cons lytname tablist)) ;(strcat curtab "." (itoa (+ (1- n) i)))
              (setvar 'ctab (strcat curtab "." (itoa (+ (1- n) i)))) ;(strcat curtab "." (itoa (+ (1- n) i))));move to new layout tab
              (setq i (1- i))
         );repeat     
       );and
    );end progn-2
   );;;;;;;;;;end if-2


   (setq nn (sslength ssrect))
   (setq cnt (- (sslength ssrect) 1))
   (repeat nn
     (setq layname (nth cnt tablist))
     (setvar 'ctab layname)
;;;;;;;;;;;;;;;;by Steven P https://www.cadtutor.net/forum/topic/76216-create-layout-from-a-grid-in-model-space/;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;create viewport from rectangle in current layout;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
           (if (setq entrec (ssname ssrect cnt));get rectangle ename
             (progn
               (setq objrec (vlax-ename->vla-object entrec));Transforms entrec to a VLA-object
               (vlax-invoke-method objrec 'GetBoundingBox 'a 'b); get max and min points of the rectangle as safe array
               (setq a (vlax-safearray->list a));convert a from safe array to list
               (setq b (vlax-safearray->list b));convert b from safe array to list
               (command "mspace")
               (vl-cmdf "_.zoom" a b)
               (command "pspace")
             );progn
             (alert "no ent")
           );if
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     (setq cnt (1- cnt)) 
     (setvar "tilemode" 0)  
   );repeat
 );end progn-1 
 (alert "NOT IN PAPER SPACE")
);end if1

;(princ tablist)
(TabSort)
(setq *error* olderr); restore *error* symbol
(princ)
);defun 


;;;;https://www.cadtutor.net/forum/topic/10087-re-ordering-layout-tabs/;;;;;
;; --------------------------------------------------------------------------- 
;; Function: tabsort 
;; Purpose : sort Tabs by the prefix then the first numbers found 
;; AUTHOR  Charles Alan Butler @ TheSwamp.org
;; --------------------------------------------------------------------------- 

;; Last Update 03/01/2006  CAB
(defun TabSort (/ cnt doc lay)
 (vl-load-com)

 ;; --------------------------------------------------------------------------- 
 ;; Function: Num_sort 
 ;; Purpose : sort list of strings by the prefix then the first numbers found 
 ;; AUTHOR  Charles Alan Butler @ TheSwamp.org
 ;; Params  : tablst:    list of strings to sort
 ;; Returns : sorted list
 ;; --------------------------------------------------------------------------- 
 (defun Num_Sort (tablst / tab ptr len loop tmp tmp2 sub lst)

   (defun vl-sort-it (lst func)
     (mapcar '(lambda (x) (nth x lst)) (vl-sort-i lst func))
   )

   (defun sort2 (tmp2 sub)
     (setq tmp2 (append
                  (vl-sort-it sub '(lambda (e1 e2) (< (cadr e1) (cadr e2))))
                  tmp2
                )
     )
   )

   ;;  convert to a list (string) -> (prefix num string)
   (foreach tab tablst
     (setq ptr  1
           len  (strlen tab)
           loop t
     )
     (while loop
       (cond
         ((wcmatch "0123456789" (strcat "*" (substr tab ptr 1) "*"))
          (setq tmp  (cons (list (substr tab 1 (1- ptr))
                                 (atof (substr tab ptr))
                                 tab
                           )
                           tmp
                     )
                loop nil
          )
         )
         ((> (setq ptr (1+ ptr)) len)
          ;;  no number in string
          (setq tmp  (cons (list tab nil tab) tmp)
                loop nil
          )
         )
       )                     ; end cond stmt
     )
   )

   ;;  sort on the prefix
   (setq tmp (vl-sort-it tmp '(lambda (e1 e2) (< (car e1) (car e2)))))

   ;; Do a number sort on each group of matching prefex
   (setq idx (length tmp))
   (while (> (setq idx (1- idx)) -1)
     (cond
       ((not sub)
        (setq sub (List (nth idx tmp))
              str (car (nth idx tmp))
        )
       )
       ((= (car (nth idx tmp)) str) ; still in the group
        (setq sub (cons (nth idx tmp) sub))
       )
     )                       ; end cond stmt

     (if (= idx 0)           ; end of list
       (progn
         (setq tmp2 (sort2 tmp2 sub))
         (if (/= (car (nth idx tmp)) str)
           (setq tmp2 (append (list (nth idx tmp)) tmp2))
         )
         (setq str (car (nth idx tmp)))
       )
     )

     (if (/= (car (nth idx tmp)) str)
       ;; next group, so sort previous group
       (setq tmp2 (sort2 tmp2 sub)
             sub  (list (nth idx tmp))
             str  (car (nth idx tmp))
       )
     )
   )                         ; end while
   (setq lst (mapcar 'caddr tmp2))
   (princ)
   lst
 )                           ; end defun
 ;;==========================================================================

 (setq cnt 1
       doc (vla-get-activedocument (vlax-get-acad-object))
 )
 (foreach lay (num_sort (vl-remove "Model" (layoutlist)))
   (vla-put-taborder (vla-item (vla-get-layouts doc) lay) cnt)
   (setq cnt (1+ cnt))
 )
 (princ)
)                           ; end defun
;;(prompt "\nTabSort loaded, enter TabSort to run.")
(princ)

Edited April 10 by aridzv

April 9

You're welcome. Glad it works

April 10

@troggarf sent you a PM.

April 11

Hi.

here is a lisp that deal with multiple rectangle frames including twisted frames and scaling the viewports.

1. the rectangels must be in "Layout_Frame" layer (hard coded to the code - can be change in the lisp) to make selecting the rectangle frames easier in big drawings with many polylines,therefore this layer must exist.

2. it can be only one viewport in the base layout that is used to copy in the lisp.

3. to control the scale, the rectangle frames must be at the same proportions as the base viewport this way:

a. draw a rectangle on the viewport so they are both identical.

b. make sure the rectangle is in "Layout_Frame" layer.

c. copy that rectangle to model space - then it can be rotated and scaled as needed.

d. scaling: for 1:5 scale the rectangle by 5, for 1:8 scale by 8, etc'

EDIT:

the rectangles must be drawn from left to right (upper left to bottom right or bottom left to upper right).

Any improvements and/or additions are welcome!!!

here are the code and sample drawing (use A-4 layout for test):

;;;;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/copy-first-layout-multiple-times-and-number-incrementally/td-p/7030955;;;
(defun c:vpfrectngl-multi1 (/ trap1 olderr baselay tablist layname cnt entrec objrec a b nn adoc curpos curtab lytname lytcnt i n twa vp1 vp1name vp1ent h fac vpvlax)

(defun trap1 (errmsg)
  (setq *error* olderr); restore *error* symbol
  (princ)
)

(setq olderr *error*); assign current function defintion held by the *error* symbol to a local variable - olderr
(setq *error* trap1); pointing the *error* symbol to new function definition - trap1

(if (tblsearch "layer" "Layout_Frame");if-0
(progn ;progn-0 
(if (= (getvar "tilemode") 0);if1 in layout
 (progn;progn-1 
   (setq baselay (getvar 'ctab));;store base layout
   (setvar "tilemode" 1);;move to mode space

   (if (setq ssrect (ssget '((0 . "LWPOLYLINE") (70 . 1) (90 . 4) (8 . "Layout_Frame"))));;;;;;;;;;if2
    (progn ;progn-2
      (setq n (sslength ssrect))
      (setvar 'ctab baselay);;back to base layout
      (and (= 0 (getvar 'tilemode))
         (setq i (getint "\nEnter begining integer for suffix: "))
         (setq curtab (getvar 'ctab))
         (repeat n 
           (setq lytcnt 1)
           (setq lytname (strcat curtab "." (itoa (+ (1- n) i))))

             (while (member lytname (layoutlist));while-1 if layout tab name exist add 1 to suffix until it is a new name  
                 (setq lytname (strcat curtab "." (itoa (+ (1- n) (+ i lytcnt)))))
                 (setq lytcnt (1+ lytcnt))
             );while-1

              (command "._layout" "_copy" "" lytname) ;(strcat curtab "." (itoa (+ (1- n) i))));;create new layout tab
              (setq tablist (cons lytname tablist)) ;(strcat curtab "." (itoa (+ (1- n) i)))
              (setvar 'ctab (strcat curtab "." (itoa (+ (1- n) i)))) ;(strcat curtab "." (itoa (+ (1- n) i))));move to new layout tab
              (setq i (1- i))
         );repeat     
       );and
    );end progn-2
    (alert "''Layout_Frame'' is not The rectangles layer.\nSet the rectangles layer to ''Layout_Frame''")
   );;;;;;;;;;end if-2

 (if ssrect ;if-3
  (progn;progn-3 
   (setq nn (sslength ssrect))
   (setq cnt (- (sslength ssrect) 1))
   (repeat nn
     (setq layname (nth cnt tablist))
     (setvar 'ctab layname)
;;;;;;;;;;;;;;;;by Steven P https://www.cadtutor.net/forum/topic/76216-create-layout-from-a-grid-in-model-space/;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;create viewport from rectangle in current layout;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
           (if (setq entrec (ssname ssrect cnt));get rectangle ename
             (progn
               (command "mspace")
;;;;;;;;;;;;;;;;;;;;twist model space view;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
               (setq pt1 (vlax-curve-getPointAtParam entrec 0))
               (setq pt2 (vlax-curve-getPointAtParam entrec 1))
               (setq twa (angle pt1 pt2))

               (if (and (/= twa 0)(< twa pi))
                 (setq twa (+ twa pi))
                 (if (and (/= twa 0)(> twa pi))
                   (setq twa (- twa pi))
                 )
               )

               (SETVAR "SNAPANG" twa)
               (setq twa (angtos twa (getvar 'aunits)))
               (setq twa (strcat "-" twa))
               (command "_.dview" "" "_tw" twa "")
;;;;;;;;;;;;;;;;;;;;twist model space view;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;set viewport BoundingBox frame ;;;;;;;;;;;;;;;;;;;;;;;;
               (setq objrec (vlax-ename->vla-object entrec));Transforms entrec to a VLA-object
               (vlax-invoke-method objrec 'GetBoundingBox 'a 'b); get max and min points of the rectangle as safe array
               (setq a (vlax-safearray->list a));convert a from safe array to list
               (setq b (vlax-safearray->list b));convert b from safe array to list
               (vl-cmdf "_.zoom" a b)
;;;;;;;;;;;;;;;;;;;;set viewport BoundingBox frame ;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;Apply Viewport scale ;;;;;;;;;;;;;;;;;;;;;;;;;
               (setq vp1 (ssget "X" (list '(0 . "VIEWPORT")(cons 410 (getvar 'ctab)))));(cons 69 2);;;get the layout viewports object selection set
               (setq vp1name (ssname vp1 0));;;get the first (and only...) viewport object name in the current layout
               (setq vp1ent (entget vp1name));;;get the viewport entity data list
               (setq h (cdr(assoc 40 vp1ent)));;;get viewport width
               (setq fac (/ h (distance pt1 pt2)));;;get the scale factor by divide the viewport width by rectangle width  
               (setq vpvlax (vlax-ename->vla-object vp1name));;;Transforms vp1name to a VLA-object
               (vla-put-customscale vpvlax fac);;;apply the scale factor to the viewport
;;;;;;;;;;;;;;;;;;;;Apply Viewport scale ;;;;;;;;;;;;;;;;;;;;;;;;;
               (command "pspace")
             );progn
             (alert "no ent")
           );if
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     (setq cnt (1- cnt)) 
     (setvar "tilemode" 0)  
   );repeat
  );end progn-3
 );end if-3
 );end progn-1 
 (alert "You are in model Space\ngo to the layout you want to use as the base layout")
);end if1
);end progn-0
(alert "Layer ''Layout_Frame'' does not exist.\nCreate this layer and make sure this is the rectangles layer.")
);end if-0
(TabSort)
(setvar 'ctab baselay)
(setq *error* olderr); restore *error* symbol
(princ)
);defun 


;;;;https://www.cadtutor.net/forum/topic/10087-re-ordering-layout-tabs/;;;;;
;; --------------------------------------------------------------------------- 
;; Function: tabsort 
;; Purpose : sort Tabs by the prefix then the first numbers found 
;; AUTHOR  Charles Alan Butler @ TheSwamp.org
;; --------------------------------------------------------------------------- 

;; Last Update 03/01/2006  CAB
(defun TabSort (/ cnt doc lay)
 (vl-load-com)

 ;; --------------------------------------------------------------------------- 
 ;; Function: Num_sort 
 ;; Purpose : sort list of strings by the prefix then the first numbers found 
 ;; AUTHOR  Charles Alan Butler @ TheSwamp.org
 ;; Params  : tablst:    list of strings to sort
 ;; Returns : sorted list
 ;; --------------------------------------------------------------------------- 
 (defun Num_Sort (tablst / tab ptr len loop tmp tmp2 sub lst)

   (defun vl-sort-it (lst func)
     (mapcar '(lambda (x) (nth x lst)) (vl-sort-i lst func))
   )

   (defun sort2 (tmp2 sub)
     (setq tmp2 (append
                  (vl-sort-it sub '(lambda (e1 e2) (< (cadr e1) (cadr e2))))
                  tmp2
                )
     )
   )

   ;;  convert to a list (string) -> (prefix num string)
   (foreach tab tablst
     (setq ptr  1
           len  (strlen tab)
           loop t
     )
     (while loop
       (cond
         ((wcmatch "0123456789" (strcat "*" (substr tab ptr 1) "*"))
          (setq tmp  (cons (list (substr tab 1 (1- ptr))
                                 (atof (substr tab ptr))
                                 tab
                           )
                           tmp
                     )
                loop nil
          )
         )
         ((> (setq ptr (1+ ptr)) len)
          ;;  no number in string
          (setq tmp  (cons (list tab nil tab) tmp)
                loop nil
          )
         )
       )                     ; end cond stmt
     )
   )

   ;;  sort on the prefix
   (setq tmp (vl-sort-it tmp '(lambda (e1 e2) (< (car e1) (car e2)))))

   ;; Do a number sort on each group of matching prefex
   (setq idx (length tmp))
   (while (> (setq idx (1- idx)) -1)
     (cond
       ((not sub)
        (setq sub (List (nth idx tmp))
              str (car (nth idx tmp))
        )
       )
       ((= (car (nth idx tmp)) str) ; still in the group
        (setq sub (cons (nth idx tmp) sub))
       )
     )                       ; end cond stmt

     (if (= idx 0)           ; end of list
       (progn
         (setq tmp2 (sort2 tmp2 sub))
         (if (/= (car (nth idx tmp)) str)
           (setq tmp2 (append (list (nth idx tmp)) tmp2))
         )
         (setq str (car (nth idx tmp)))
       )
     )

     (if (/= (car (nth idx tmp)) str)
       ;; next group, so sort previous group
       (setq tmp2 (sort2 tmp2 sub)
             sub  (list (nth idx tmp))
             str  (car (nth idx tmp))
       )
     )
   )                         ; end while
   (setq lst (mapcar 'caddr tmp2))
   (princ)
   lst
 )                           ; end defun
 ;;==========================================================================

 (setq cnt 1
       doc (vla-get-activedocument (vlax-get-acad-object))
 )
 (foreach lay (num_sort (vl-remove "Model" (layoutlist)))
   (vla-put-taborder (vla-item (vla-get-layouts doc) lay) cnt)
   (setq cnt (1+ cnt))
 )
 (princ)
)                           ; end defun
;;(prompt "\nTabSort loaded, enter TabSort to run.")
(princ)

rectolayout.dwgFetching info...

Edited April 12 by aridzv

April 18

@troggarf sent you a private mail.

Sign In

Create Layout from a grid in model space

Recommended Posts

itacad

BIGAL

Steven P

itacad

mhupp

itacad

Catherine M

aridzv

BIGAL

troggarf

troggarf

aridzv

Saxlle

aridzv

Saxlle

BIGAL

aridzv

BIGAL

Join the conversation

Tutorials

Forums

Activity