Jump to content

AutoLayouts lisp


David1234

Recommended Posts

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 by SLW210
Added Code Tags!
Link to comment
Share on other sites

@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))))
    )
  )
)

 

Link to comment
Share on other sites

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?

Link to comment
Share on other sites

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!

  • Like 1
Link to comment
Share on other sites

  • 2 months later...
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

Link to comment
Share on other sites

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))))
    )
  )
)

 

Link to comment
Share on other sites

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:

Link to comment
Share on other sites

@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.

Link to comment
Share on other sites

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.

 

 

 

Link to comment
Share on other sites

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?

Untitled.png

Link to comment
Share on other sites

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?

Untitled.png

 

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

Link to comment
Share on other sites

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)))
   )
   )
)

 

Link to comment
Share on other sites

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))
            )
        )
    )
)

 

  • Thanks 1
Link to comment
Share on other sites

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!!!

  • Like 1
Link to comment
Share on other sites

  • 2 weeks later...

Hi

 

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

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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.

 

image.thumb.png.8300fe83bdeb9b238d071f8199d09b35.png

 

This image is from 7 sheets produced automatically.

Edited by BIGAL
Link to comment
Share on other sites

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

Link to comment
Share on other sites

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.

 

layout1.png.9d03ab6cd7fbd5b4a128c15fbe0c31bf.png

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...