AutoLayouts lisp

[David1234]

Hi, i have found a great AutoLayout lisp from this YouTube video

 

https://www.youtube.com/watch?v=i-uDvEcrH1I

 

I was wondering if someone could please help me edit the lisp.

 

When running the command it ask for ' Starting Layout number' but would like this the be alphabet characters instead, so my layouts would be called for example (TEST-A, TEST-B, TEST-C  etc.)

 

Any much would be much appreciated, Merry Xmas...

 

David

(defun C:TabSort (/ cnt doc lay)
(vl-load-com)
(setq cnt 1
doc (vla-get-activedocument (vlax-get-acad-object))
)
(foreach lay (acad_strlsort (vl-remove "Model" (layoutlist)))
(vla-put-taborder (vla-item (vla-get-layouts doc) lay) cnt)
(setq cnt (1+ cnt))
)
(princ)
)

(defun c:cll (/ a adoc curpos curtab i n)
(setvar "tilemode" 0)
(and (= 0 (getvar 'tilemode))
(setq i (getint "\nEnter Starting Layout number: ")
curtab (substr (getvar 'ctab) 1 (- (strlen (getvar 'ctab)) 2))
n (getint "\nHow many copies of this tab: "))
(repeat n
(command "._layout" "_copy" "" (strcat curtab (if (= 1 (strlen (setq a (itoa (+ (1- n) i)))))
(strcat "0" a)
a)))
(setq i (1- i)))))

(defun c:cl (/)
(c:cll)
(C:TabSort)
)
(c:cl)

autolayout.LSP

Edited December 21, 2023 by SLW210
Added Code Tags!

[pkenewell]

@David1234 This is how I would rewrite it:

(defun c:TabSort (/ cnt doc lay)
   (vl-load-com)
   (setq cnt 1
         doc (vla-get-activedocument (vlax-get-acad-object))
   )
   (foreach lay (acad_strlsort (vl-remove "Model" (layoutlist)))
      (vla-put-taborder (vla-item (vla-get-layouts doc) lay) cnt)
      (setq cnt (1+ cnt))
   )
   (princ)
)

(defun c:cLO (/ cnt ctb prf n)
   (setvar "tilemode" 0)
   (if (and 
          (= 0 (getvar 'tilemode))
          (setq str (getstring "\nEnter Starting Layout Letter: "))
          (setq ctb (substr (getvar 'ctab) 1 (- (strlen (getvar 'ctab)) 1)))
          (setq prf (getstring (strcat "\nLayout Prefix <" ctb ">: "))
                prf (if (/= prf "") prf ctb)
          )
          (setq n   (getint "\nHow many copies of this tab: "))
       )
      (progn
         (setq cnt 1)
         (initget "Yes No")
         (if (= (getkword "\nRename Current Layout? [Yes/No] <No>: ") "Yes")
            (progn
               (command "._Layout" "_Rename" (getvar 'ctab) (strcat prf str))
               (setq cnt (1+ cnt))
            )
         )
         (repeat n
            (command "._layout" "_copy" (getvar 'ctab)
                     (strcat prf (if (> cnt 1)(setq str (ai str 1)) str))
            )
            (setq cnt (1+ cnt))
         )
      )
   )
   (c:TabSort)
)

;;https://www.theswamp.org/index.php?topic=51964.msg570164#msg570164
;; By ElpanovEvgeniy
(defun ai (s i / A B L)
  (setq l (strlen s)
            a (ascii (substr s l))
            b (cond ((< 64 a 91) 64)
                    ((< 96 a 123) 96)
              )
      )
  (and (minusp i)(<(- a (abs i) b)1) (setq i (+ 26  i (/ i -26))))
  (if b
    (strcat (substr s 1 (1- l))
            (cond ((< (+ b 26) (+ i a)) (chr (+ b (/ (- (+ i a) b) 26))))
                  ("")
            )
            (chr (+ b ((lambda(c)(if (zerop c) 26 c)) (rem  (- (+ i a) b) 26))))
    )
  )
)

 

[David1234]

Thanks for your help, i have tried it but nothing it happening when i run it?

[pkenewell]

12 hours ago, David1234 said:

Thanks for your help, i have tried it but nothing it happening when i run it?

My rewrite doesn't run automatically when loaded. Did you type the command CLO to start the routine? Does it give an error?

[David1234]

That worked PEFRECT!!! Thank you so much, this will save me so much time!

 

I thought the command was 'TabSort' my mistake 

 

 

Thank you again, much appreciated!

[David1234]

On 21/12/2023 at 21:53, pkenewell said:

@David1234 This is how I would rewrite it:

(defun c:TabSort (/ cnt doc lay)
   (vl-load-com)
   (setq cnt 1
         doc (vla-get-activedocument (vlax-get-acad-object))
   )
   (foreach lay (acad_strlsort (vl-remove "Model" (layoutlist)))
      (vla-put-taborder (vla-item (vla-get-layouts doc) lay) cnt)
      (setq cnt (1+ cnt))
   )
   (princ)
)

(defun c:cLO (/ cnt ctb prf n)
   (setvar "tilemode" 0)
   (if (and 
          (= 0 (getvar 'tilemode))
          (setq str (getstring "\nEnter Starting Layout Letter: "))
          (setq ctb (substr (getvar 'ctab) 1 (- (strlen (getvar 'ctab)) 1)))
          (setq prf (getstring (strcat "\nLayout Prefix <" ctb ">: "))
                prf (if (/= prf "") prf ctb)
          )
          (setq n   (getint "\nHow many copies of this tab: "))
       )
      (progn
         (setq cnt 1)
         (initget "Yes No")
         (if (= (getkword "\nRename Current Layout? [Yes/No] <No>: ") "Yes")
            (progn
               (command "._Layout" "_Rename" (getvar 'ctab) (strcat prf str))
               (setq cnt (1+ cnt))
            )
         )
         (repeat n
            (command "._layout" "_copy" (getvar 'ctab)
                     (strcat prf (if (> cnt 1)(setq str (ai str 1)) str))
            )
            (setq cnt (1+ cnt))
         )
      )
   )
   (c:TabSort)
)

;;https://www.theswamp.org/index.php?topic=51964.msg570164#msg570164
;; By ElpanovEvgeniy
(defun ai (s i / A B L)
  (setq l (strlen s)
            a (ascii (substr s l))
            b (cond ((< 64 a 91) 64)
                    ((< 96 a 123) 96)
              )
      )
  (and (minusp i)(<(- a (abs i) b)1) (setq i (+ 26  i (/ i -26))))
  (if b
    (strcat (substr s 1 (1- l))
            (cond ((< (+ b 26) (+ i a)) (chr (+ b (/ (- (+ i a) b) 26))))
                  ("")
            )
            (chr (+ b ((lambda(c)(if (zerop c) 26 c)) (rem  (- (+ i a) b) 26))))
    )
  )
)

 

Hi,

 

Ever since i have updated my Gstar cad to the latest version, i am now getting this error when trying to run this LISP

 

; error: bad argument value: positive 0

 

Any idea on how to fix would be greatly appreciated as it was a huge help before when was working thanks to your excellent help!

 

Thank you

[Steven P]

I don't have Gstar but maybe you can help - how far through this does it get before the error? Does it ask for any user inputs or error before then?

 

I'll often print a small report along the way to the command line when debugging, if it displays the report then all is good up to that point, something like this maybe (untested so hoping I haven't got brackets in the wrong place):

 

Let us know how far through the routine gets and that will narrow the problem down

 

(defun c:TabSort (/ cnt doc lay)

(princ "\nTab Sort Started: ")

   (vl-load-com)
   (setq cnt 1
         doc (vla-get-activedocument (vlax-get-acad-object))
   )
   (foreach lay (acad_strlsort (vl-remove "Model" (layoutlist)))
      (vla-put-taborder (vla-item (vla-get-layouts doc) lay) cnt)
      (setq cnt (1+ cnt))
   )

(princ "\nTab sort Ended. ")

   (princ)
)

(defun c:cLO (/ cnt ctb prf n)

(princ "\CLO Started: ")

   (setvar "tilemode" 0)
   (if (and 
          (= 0 (getvar 'tilemode))
          (setq str (getstring "\nEnter Starting Layout Letter: "))
          (setq ctb (substr (getvar 'ctab) 1 (- (strlen (getvar 'ctab)) 1)))
          (setq prf (getstring (strcat "\nLayout Prefix <" ctb ">: "))
                prf (if (/= prf "") prf ctb)
          )
          (setq n   (getint "\nHow many copies of this tab: "))
       )
      (progn
         (setq cnt 1)

(princ "CLO 'IF' OK")

         (initget "Yes No")
         (if (= (getkword "\nRename Current Layout? [Yes/No] <No>: ") "Yes")
            (progn
               (command "._Layout" "_Rename" (getvar 'ctab) (strcat prf str))

(princ "CLO Got keyword: ")

               (setq cnt (1+ cnt))
            )
         )
         (repeat n
            (command "._layout" "_copy" (getvar 'ctab)
                     (strcat prf (if (> cnt 1)(setq str (ai str 1)) str))
            )

(princ "\ncopied layout )(princ cnt)

            (setq cnt (1+ cnt))
         )
      )
   )
   (c:TabSort)
)

;;https://www.theswamp.org/index.php?topic=51964.msg570164#msg570164
;; By ElpanovEvgeniy
(defun ai (s i / A B L)
  (setq l (strlen s)
            a (ascii (substr s l))
            b (cond ((< 64 a 91) 64)
                    ((< 96 a 123) 96)
              )
      )
  (and (minusp i)(<(- a (abs i) b)1) (setq i (+ 26  i (/ i -26))))
  (if b
    (strcat (substr s 1 (1- l))
            (cond ((< (+ b 26) (+ i a)) (chr (+ b (/ (- (+ i a) b) 26))))
                  ("")
            )
            (chr (+ b ((lambda(c)(if (zerop c) 26 c)) (rem  (- (+ i a) b) 26))))
    )
  )
)

 

[David1234]

This is what was showing in the command line

 

Command: clo
Enter Starting Layout Letter: A
Layout Prefix <A4 Layou>: COL-
How many copies of this tab: 10
Rename Current Layout? [Yes/No] <No>: 
; error: bad argument value: positive 0
Enter layout name for copy <A4 Layout (2)>: 
Layout "A4 Layout" copied to "A4 Layout (2)".

 

Ive tried the new one you suggested but it says its successfully loaded but then says this afterwards in the command line?

 

; error: LOAD failed:

[pkenewell]

@David1234 Sorry, I can't help much without a copy of GstarCAD, but tell me: does my original rewrite actually rename any of the layouts before crashing? This would help narrow down where the error is occuring.

[BIGAL]

Maybe something like this 2 versions, along a line/pline or grid style, the rectangs can be moved, rotated, deleted, then layouts made. The scale is set and the size of the sheet is set also.

 

 

 

[David1234]

30 minutes ago, pkenewell said:

@David1234 Sorry, I can't help much without a copy of GstarCAD, but tell me: does my original rewrite actually rename any of the layouts before crashing? This would help narrow down where the error is occuring.

 

Yes its very strange, was working great before the update!

 

Here is a screen shot of whats happening if that is any help?

[David1234]

Just now, David1234 said:

 

Yes its very strange, was working great before the update!

 

Here is a screen shot of whats happening if that is any help?

 

Before its would create and rename the new layouts 'COL-A, COL-B, COL-C and so on....' for the number of copies choosen

[BIGAL]

An example tab rename should make them xx-1 xx-2 etc, if you want A B C then look at the fact that "A"  = (chr 65) so you can use taborder and add to the 65 and it will use a alpha character, be aware you have a problem at 26 ie Z, one of my dwg's 88 layouts.

 

Cut out of a bigger rename layouts

(setq tabs  (vla-get-Layouts (vla-get-activedocument (vlax-get-acad-object))))
(vlax-for lay tabs
  (if (/= (vla-get-name lay) "Model" )
  (progn
   (setq num (vla-get-taborder lay))
   (vla-put-name lay (strcat "XX-" (rtos num 2 0)))
   )
   )
)

 

[pkenewell]

16 hours ago, David1234 said:

Yes its very strange, was working great before the update!

 

Here is a screen shot of whats happening if that is any help?

It may have something to do with "ai" function by ElpanovEvgeniy? I don't know what that might be. Perhaps we should try and change that function to LeeMac's Increment function. I tested this in AutoCAD and it works.

(defun c:TabSort (/ cnt doc lay)
   (vl-load-com)
   (setq cnt 1
         doc (vla-get-activedocument (vlax-get-acad-object))
   )
   (foreach lay (acad_strlsort (vl-remove "Model" (layoutlist)))
      (vla-put-taborder (vla-item (vla-get-layouts doc) lay) cnt)
      (setq cnt (1+ cnt))
   )
   (princ)
)

(defun c:cLO (/ cnt ctb prf n)
   (setvar "tilemode" 0)
   (if (and 
          (= 0 (getvar 'tilemode))
          (setq str (getstring "\nEnter Starting Layout Letter: "))
          (setq ctb (substr (getvar 'ctab) 1 (- (strlen (getvar 'ctab)) 1)))
          (setq prf (getstring (strcat "\nLayout Prefix <" ctb ">: "))
                prf (if (/= prf "") prf ctb)
          )
          (setq n   (getint "\nHow many copies of this tab: "))
       )
      (progn
         (setq cnt 1)
         (initget "Yes No")
         (if (= (getkword "\nRename Current Layout? [Yes/No] <No>: ") "Yes")
            (progn
               (command "._Layout" "_Rename" (getvar 'ctab) (strcat prf str))
               (setq cnt (1+ cnt) n (1- n))
            )
         )
         (repeat n
            (command "._layout" "_copy" (getvar 'ctab)
                     (strcat prf (if (> cnt 1)(setq str (numinc:incrementalpha str 1)) str))
            )
            (setq cnt (1+ cnt))
         )
      )
   )
   (c:TabSort)
)

;; Extracted from Lee Mac's Increment Numbering Suite:
;; https://www.lee-mac.com/numinc.html
(defun numinc:incrementalpha ( str inc / _incrementalpha a )
 
    (defun _incrementalpha ( a b / c d e )
        (cond
            (   (cond
                    (   (< 47 (setq c (car a)) 58)
                        (setq d 48
                              e 10
                        )
                    )
                    (   (< 64 c 91)
                        (setq d 65
                              e 26
                        )
                    )
                    (   (< 96 c 123)
                        (setq d 97
                              e 26
                        )
                    )
                )
                (setq c (+ (- c d) b)
                      b (/ c e)
                )
                (cons (+ d (rem c e))
                    (if (zerop b)
                        (cdr a)
                        (if (cdr a)
                            (_incrementalpha (cdr  a) b)
                            (_incrementalpha (list d) (if (= 10 e) b (1- b)))
                        )
                    )
                )
            )
            (   (cons c
                    (if (cdr a)
                        (_incrementalpha (cdr a) b)
                        (_incrementalpha (list 65) (1- b))
                    )
                )
            )
        )
    )
 
    (vl-list->string
        (reverse
            (if (setq a (reverse (vl-string->list str)))
                (_incrementalpha a inc)
                (_incrementalpha '(65) (1- inc))
            )
        )
    )
)

 

[David1234]

5 hours ago, pkenewell said:

It may have something to do with "ai" function by ElpanovEvgeniy? I don't know what that might be. Perhaps we should try and change that function to LeeMac's Increment function. I tested this in AutoCAD and it works.

(defun c:TabSort (/ cnt doc lay)
   (vl-load-com)
   (setq cnt 1
         doc (vla-get-activedocument (vlax-get-acad-object))
   )
   (foreach lay (acad_strlsort (vl-remove "Model" (layoutlist)))
      (vla-put-taborder (vla-item (vla-get-layouts doc) lay) cnt)
      (setq cnt (1+ cnt))
   )
   (princ)
)

(defun c:cLO (/ cnt ctb prf n)
   (setvar "tilemode" 0)
   (if (and 
          (= 0 (getvar 'tilemode))
          (setq str (getstring "\nEnter Starting Layout Letter: "))
          (setq ctb (substr (getvar 'ctab) 1 (- (strlen (getvar 'ctab)) 1)))
          (setq prf (getstring (strcat "\nLayout Prefix <" ctb ">: "))
                prf (if (/= prf "") prf ctb)
          )
          (setq n   (getint "\nHow many copies of this tab: "))
       )
      (progn
         (setq cnt 1)
         (initget "Yes No")
         (if (= (getkword "\nRename Current Layout? [Yes/No] <No>: ") "Yes")
            (progn
               (command "._Layout" "_Rename" (getvar 'ctab) (strcat prf str))
               (setq cnt (1+ cnt) n (1- n))
            )
         )
         (repeat n
            (command "._layout" "_copy" (getvar 'ctab)
                     (strcat prf (if (> cnt 1)(setq str (numinc:incrementalpha str 1)) str))
            )
            (setq cnt (1+ cnt))
         )
      )
   )
   (c:TabSort)
)

;; Extracted from Lee Mac's Increment Numbering Suite:
;; https://www.lee-mac.com/numinc.html
(defun numinc:incrementalpha ( str inc / _incrementalpha a )
 
    (defun _incrementalpha ( a b / c d e )
        (cond
            (   (cond
                    (   (< 47 (setq c (car a)) 58)
                        (setq d 48
                              e 10
                        )
                    )
                    (   (< 64 c 91)
                        (setq d 65
                              e 26
                        )
                    )
                    (   (< 96 c 123)
                        (setq d 97
                              e 26
                        )
                    )
                )
                (setq c (+ (- c d) b)
                      b (/ c e)
                )
                (cons (+ d (rem c e))
                    (if (zerop b)
                        (cdr a)
                        (if (cdr a)
                            (_incrementalpha (cdr  a) b)
                            (_incrementalpha (list d) (if (= 10 e) b (1- b)))
                        )
                    )
                )
            )
            (   (cons c
                    (if (cdr a)
                        (_incrementalpha (cdr a) b)
                        (_incrementalpha (list 65) (1- b))
                    )
                )
            )
        )
    )
 
    (vl-list->string
        (reverse
            (if (setq a (reverse (vl-string->list str)))
                (_incrementalpha a inc)
                (_incrementalpha '(65) (1- inc))
            )
        )
    )
)

 

That has fixed it and back working perfectly again, i cant thank you enough!!!

[sudheendra]

Hi

 

Is it possible to develop program for Autolayout for Road Alignment and Profile with different Scales and Sheets Size

[Steven P]

7 hours ago, sudheendra said:

Hi

 

Is it possible to develop program for Autolayout for Road Alignment and Profile with different Scales and Sheets Size

 

You'll probably get better answer if you start a new thread with this one, perhaps with an example drawing showing your starting point and what you want the LISP to create.

[BIGAL]

The answer to your question is say CIV3D or for me "Civil Site Design"  just Google.

 

Yes does walk along alignment, road design, plot cross sections, long sections with or without plan on same sheet.

 

 

This image is from 7 sheets produced automatically.

Edited March 17 by BIGAL

[sudheendra]

But how to use in Civil Site Design. if you have link for downloading please share 

[BIGAL]

Are you designing roads or just want the field survey plotted ?

 

If so like this rectangs are auto generated at scale following a line or pline, then can auto make layouts.