Jump to content

Renaming layout tab with 2 titleblock attributes

JADT

By JADT
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

JADT Contributor

JADT

Posted
  • Author
Posted

Hi All,

thanks for the thread hi-jack...

My problem has not been resolved but glad others have. I understand everyone here is helping each other out for free and out of the goodness of their hearts, so If there is any of that coding love left over, could someone please help out with my issues in the original thread.

just to recap:

pBe's code did just what I needed...but when adding new layouts to a project and re-running the lisp it added a (1) suffix to all the existing layouts - a failsafe that pBe put in to avoid any issues with layouts having the same name...I would prefer for the code to ignore renaming layouts if they haven't changed in the tags they are reading or at least to not suffix with (1).

I hope someone can help with this

and thanks once again for everyone's time..i'm only on the 'hello world' stage of learning code.

  • Replies 30
  • Created
  • Last Reply

Top Posters In This Topic

  • JADT

    9

  • Lee Mac

    7

  • Tharwat

    5

  • pBe

    4

Popular Days

Top Posters In This Topic

Popular Days

Posted Images

Lee Mac Grand Master

Lee Mac

Posted
Posted

Here is a quick modification of my code from Reply#15:

([color=BLUE]defun[/color] c:relay ( [color=BLUE]/[/color] a e i l n r s x )
   ([color=BLUE]if[/color] ([color=BLUE]setq[/color] s ([color=BLUE]ssget[/color] [color=MAROON]"_X"[/color] '((0 . [color=MAROON]"INSERT"[/color]) (66 . 1) (2 . [color=MAROON]"A1 Border"[/color]) (410 . [color=MAROON]"~Model"[/color]))))
       ([color=BLUE]progn[/color]
           ([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] i ([color=BLUE]sslength[/color] s))
               ([color=BLUE]setq[/color] e ([color=BLUE]entnext[/color] ([color=BLUE]ssname[/color] s ([color=BLUE]setq[/color] i ([color=BLUE]1-[/color] i))))
                     x ([color=BLUE]entget[/color] e)
                     a [color=BLUE]nil[/color]
               )
               ([color=BLUE]while[/color] ([color=BLUE]=[/color] [color=MAROON]"ATTRIB"[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 0 x)))
                   ([color=BLUE]setq[/color] a ([color=BLUE]cons[/color] ([color=BLUE]cons[/color] ([color=BLUE]strcase[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 2 x))) ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 1 x))) a)
                         e ([color=BLUE]entnext[/color] e)
                         x ([color=BLUE]entget[/color]  e)
                   )
               )
               ([color=BLUE]setq[/color] l ([color=BLUE]cons[/color] ([color=BLUE]cons[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 410 ([color=BLUE]entget[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 330 x))))) a) l))
           )
           ([color=BLUE]vlax-for[/color] x ([color=BLUE]vla-get-layouts[/color] ([color=BLUE]vla-get-activedocument[/color] ([color=BLUE]vlax-get-acad-object[/color])))
               ([color=BLUE]if[/color]
                   ([color=BLUE]and[/color]
                       ([color=BLUE]setq[/color] a ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] ([color=BLUE]vla-get-name[/color] x) l)))
                       ([color=BLUE]setq[/color] n ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] [color=MAROON]"DRAWINGNO."[/color] a)))
                       ([color=BLUE]setq[/color] r ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] [color=MAROON]"REV"[/color] a)))
                   )
                   ([color=BLUE]vl-catch-all-apply[/color] '[color=BLUE]vla-put-name[/color] ([color=BLUE]list[/color] x ([color=BLUE]strcat[/color] n [color=MAROON]"_"[/color] r)))
               )
           )
       )
       ([color=BLUE]princ[/color] [color=MAROON]"\nNo \"A1 Border\" blocks found."[/color])
   )
   ([color=BLUE]princ[/color])
)
([color=BLUE]vl-load-com[/color]) ([color=BLUE]princ[/color])

The above program is untested however.

JADT Contributor

JADT

Posted
  • Author
Posted

Lee,

thanks for your speedy reply. on first test it seems to work. That's really helped. Thank you.

 

Just realised though, on the project I have just tested, we have various sized drawings some A3 as such they didn't rename. Would it be possible to add into the code to search on all the company standard size border blocks that 'may' be in use in a project.

they are

A0 Border

A1 Border

A2 Border

A3 Border

Lee Mac Grand Master

Lee Mac

Posted
Posted
Lee,

thanks for your speedy reply. on first test it seems to work. That's really helped. Thank you.

 

You're welcome :)

 

Would it be possible to add into the code to search on all the company standard size border blocks that 'may' be in use in a project.

they are

A0 Border

A1 Border

A2 Border

A3 Border

 

Change:

(2 . [color=MAROON]"A1 Border"[/color])

to:

(2 . [color=MAROON]"A[0-3] Border"[/color])

JADT Contributor

JADT

Posted
  • Author
Posted

Lee, thanks for your help. All seems to work perfectly.

  • 2 months later...
asos2000 Mentor

asos2000

Posted
Posted
Try this quick code:

...

I am tring to modfy this lisp to mach my needs

How to grab attribute tag?

(defun c:relay ( / a blk e i l n r s tg x )
 ;;  Author: Lee Mac, www.lee-mac.com
 
 (setq *blknm 	"*-A[0-3]-TB")	; Title Block
 (setq *tg 	"A000")		; Drawing Number TAG in title block  

 (if (not *ans) (setq *ans "RenameLayout"))	;check for editing setting or not
 (initget "RenameLayout Setting")
 (setq *ans (cond ( (getkword (strcat "\n Title Block Name: "	*blknm
			       " ,Drawing Number TAG: " *tg
			       " Choose [RenameLayout/Setting] <" *ans ">: ")))( *ans )))
 (if (> 8 (strlen *ans)) 		;editing setting or not
     (progn
(setq blk 	(entget (car (entsel "Select Drawing Number in Title Block: "))))
(setq *blknm	(cdr (assoc 2 blk)))	
[color="red"]	(setq *tg *tg)     <--- How to grab attribute tag [/color]
))

 (if (setq s (ssget "_X" (list '(0 . "INSERT") '(66 . 1) (cons 2 *blknm) '(410 . "~Model"))))
       (progn
           (repeat (setq i (sslength s))
      (setq e (entnext (ssname s (setq i (1- i)))))
      (setq x (entget e))
      (setq a nil)
               )
               (while (= "ATTRIB" (cdr (assoc 0 x)))
                   (setq a (cons (cons (strcase (cdr (assoc 2 x))) (cdr (assoc 1 x))) a)
                         e (entnext e)
                         x (entget  e)
                   )
               )
               (setq l (cons (cons (cdr (assoc 410 (entget (cdr (assoc 330 x))))) a) l))
           )
           (vlax-for x (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object)))
               (if
                   (and
                       (setq a (cdr (assoc (vla-get-name x) l)))
                       (setq n (cdr (assoc *tg a)))                        
                   )
                   (vl-catch-all-apply 'vla-put-name (list x n ))
               )
           )
       )
 (princ "\nNo title block found.")
   )
   (princ)
)
(vl-load-com) (princ)

Lee Mac Grand Master

Lee Mac

Posted
Posted
I am tring to modfy this lisp to mach my needs

How to grab attribute tag?

 

I would suggest the following Hasan:

([color=BLUE]defun[/color] c:relay ( [color=BLUE]/[/color] *ans* a att blk e enx i l n s tag tmp x )
   [color=GREEN];;  Author: Lee Mac, www.lee-mac.com[/color]
   
   ([color=BLUE]setq[/color] blk [color=MAROON]"*-A[0-3]-TB"[/color] [color=GREEN];; Block[/color]
         tag [color=MAROON]"A000"[/color]        [color=GREEN];; Tag[/color]
   )
   ([color=BLUE]if[/color] ([color=BLUE]null[/color] *ans*)
       ([color=BLUE]setq[/color] *ans* [color=MAROON]"Rename"[/color])
   )
   ([color=BLUE]while[/color]
       ([color=BLUE]progn[/color]
           ([color=BLUE]initget[/color] [color=MAROON]"Rename Settings"[/color])
           ([color=BLUE]if[/color] ([color=BLUE]setq[/color] tmp ([color=BLUE]getkword[/color] ([color=BLUE]strcat[/color] [color=MAROON]"\nBlock: \""[/color] blk [color=MAROON]"\", Tag: \""[/color] tag [color=MAROON]"\" [Rename/Settings] <"[/color] *ans* [color=MAROON]">: "[/color])))
               ([color=BLUE]setq[/color] *ans* tmp)
               ([color=BLUE]setq[/color] tmp *ans*)
           )
           ([color=BLUE]/=[/color] [color=MAROON]"Rename"[/color] tmp)
       )
       ([color=BLUE]while[/color]
           ([color=BLUE]progn[/color]
               ([color=BLUE]setvar[/color] 'errno 0)
               ([color=BLUE]setq[/color] att ([color=BLUE]car[/color] ([color=BLUE]nentsel[/color] [color=MAROON]"\nSelect drawing number <back>: "[/color])))
               ([color=BLUE]cond[/color]
                   (   ([color=BLUE]=[/color] 7 ([color=BLUE]getvar[/color] 'errno))
                       ([color=BLUE]princ[/color] [color=MAROON]"\nMissed, try again."[/color])
                   )
                   (   ([color=BLUE]null[/color] att) [color=BLUE]nil[/color])
                   (   ([color=BLUE]/=[/color] [color=MAROON]"ATTRIB"[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 0 ([color=BLUE]setq[/color] enx ([color=BLUE]entget[/color] att)))))
                       ([color=BLUE]princ[/color] [color=MAROON]"\nPlease select drawing number attribute."[/color])
                   )
                   (   ([color=BLUE]setq[/color] tag ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 2 enx))
                             blk ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 2 ([color=BLUE]entget[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 330 enx)))))
                       )
                       [color=BLUE]nil[/color]
                   )
               )
           )
       )
   )
   ([color=BLUE]if[/color] ([color=BLUE]setq[/color] s ([color=BLUE]ssget[/color] [color=MAROON]"_X"[/color] ([color=BLUE]list[/color] '(0 . [color=MAROON]"INSERT"[/color]) '(66 . 1) ([color=BLUE]cons[/color] 2 blk) '(410 . [color=MAROON]"~Model"[/color]))))
       ([color=BLUE]progn[/color]
           ([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] i ([color=BLUE]sslength[/color] s))
               ([color=BLUE]setq[/color] e ([color=BLUE]entnext[/color] ([color=BLUE]ssname[/color] s ([color=BLUE]setq[/color] i ([color=BLUE]1-[/color] i))))
                     x ([color=BLUE]entget[/color] e)
                     a [color=BLUE]nil[/color]
               )
               ([color=BLUE]while[/color] ([color=BLUE]=[/color] [color=MAROON]"ATTRIB"[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 0 x)))
                   ([color=BLUE]setq[/color] a ([color=BLUE]cons[/color] ([color=BLUE]cons[/color] ([color=BLUE]strcase[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 2 x))) ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 1 x))) a)
                         e ([color=BLUE]entnext[/color] e)
                         x ([color=BLUE]entget[/color]  e)
                   )
               )
               ([color=BLUE]setq[/color] l ([color=BLUE]cons[/color] ([color=BLUE]cons[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 410 ([color=BLUE]entget[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 330 x))))) a) l))
           )
           ([color=BLUE]vlax-for[/color] x ([color=BLUE]vla-get-layouts[/color] ([color=BLUE]vla-get-activedocument[/color] ([color=BLUE]vlax-get-acad-object[/color])))
               ([color=BLUE]if[/color]
                   ([color=BLUE]and[/color]
                       ([color=BLUE]setq[/color] a ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] ([color=BLUE]vla-get-name[/color] x) l)))
                       ([color=BLUE]setq[/color] n ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] tag a)))
                   )
                   ([color=BLUE]vl-catch-all-apply[/color] '[color=BLUE]vla-put-name[/color] ([color=BLUE]list[/color] x n))
               )
           )
       )
       ([color=BLUE]princ[/color] [color=MAROON]"\nNo title block found."[/color])
   )
   ([color=BLUE]princ[/color])
)
([color=BLUE]vl-load-com[/color]) ([color=BLUE]princ[/color])

asos2000 Mentor

asos2000

Posted
Posted (edited)

Brilliant as usual

What about replace 

(setq blk "*-A[0-3]-TB")

With

(if (setq ss (ssget "_X" (list '(0 . "INSERT") '(66 . 1) (cons 2 "*TB") '(410 . "~Model"))))
 (setq blk (cdr (assoc 2 (entget (ssname ss 0)))))
 (setq blk "\nNo title block found."))

 

Edit:

Instead of grabing tag, could the prompt be grabed?

I used 

(setq enx (entget att))

but couldnet find DXF for prompt

Edited by asos2000
pBe Grand Master

pBe

Posted
Posted
Hi All,

pBe's code did just what I needed...but when adding new layouts to a project and re-running the lisp it added a (1) suffix to all the existing layouts - a failsafe that pBe put in to avoid any issues with layouts having the same name.

 

It would be easy to modify the code to meet your conditions but I see you already have a solution from Lee. (kudos to LM)

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.

×
 Share
Go to topic listing
×
×
  • Create New...