Insert New RevBlock above existing RevBlock in Layout tabs

[Fett2oo5]

We are looking for a way to revise multiple layout tabs (single .dwg file) at one time.

 

We design our product in 2D in one .dwg file. We use the layout tabs for multiple views of the objects that are in modelspace, (each layout tab has the project titleblock on it, but each layout tab has its own set of revision blocks.)

We "stack" the revision blocks in the Y direction, please see first screenshot)

 

There are times in the project when ALL layout tabs need the same revision description. For example, Issue for Construction, P.E. comments, As Built... etc. This was previously done by inserting the RevBlk, editing attributes, Copy-Basepoint, switching to each layout tab, and pasting above the existing RevBlk.

 

So we would like to be able to insert a revision block into each layout tab using a dialog box or excel.

 

Explained simply (hopefully): The routine would find the revision block (RevBlk) with the largest Y value (because we "stack" the revision blocks in the Y direction, please see example) and insert a new revision block (RevBlk) above it. The height (in Y direction) of the block is .1271, so the new RevBlk would need it's insertion point @0,.1271,0 in relation to the existing RevBlk with the highest Y value. Please see first screenshot:

 

 

 

Our Layout Tab labels follow this sequence:

 

Following that numbering sequence these are possible but not so frequent:

 

 

 

It would be nice if we could control the insertion of new revisions from a dialog box:

(the routine would need to detect what tabs were available?)

I'm sorry for the way it looks, the only way I know how to make one is in Excel's VBA

 

 

Also, I have a grander vision to define project parameters in Excel and then the appropriate blocks will be inserted (from the block library) into the new .dwg file.

So I'm hoping this smaller task will help me along with the larger endeavor.

InsertNewRevBlocks.dwg

Edited January 4, 2016 by Fett2oo5
Added Example .dwg File

[Fett2oo5]

Is this too ambitious?

 

Perhaps we could piece this together?

 

1. Find the insertion points of a particular block across all layout tabs. (block name will never change RevBlk)

 

2. Prompt user for new attribute values. Insert the same block (RevBlk will already be loaded into drawing) at the largest Y value of another RevBlk +.1271, across all layout tabs.

 

The part that is tripping me up is the "across all layout tabs"

 

I think those would get us started on the path.

 

 

If no code solution is available; links to examples, tutorials, similar situations, anything will help. I've been searching google, cadtutor, autodesk forums, the swamp, just looking for help.

Edited January 4, 2016 by Fett2oo5

[BIGAL]

Issued for construction.

 

Re part 2 the dcl lot of work maybe better with a to/from excell

 

; changes to issued for construction
; by Aalan H
(vl-load-com)
; 1.  Get current date in mm/dd/yy format.
(defun ddmmyy (/ x today)
    (setvar "cmdecho" 0)
    (setq x (getvar "CDATE"))                 ; get current date
    (setq today ( rtos x 2 4))                    ; convert to a string
    (setq date (strcat (substr today 7 2) "."    (substr today 5 2) "." (substr today 3 2) ))
)


(setq oldtag1 "DRAWING_STATUS") ;attribute tag name
(setq newstr1 "ISSUED FOR CONSTRUCTION")
(setq oldtag2 "REV_NO")  ;attribute tag name
(setq newstr2 "0")

(setq ss1 (ssget "x"  '((0 . "INSERT") (2 . "DA1DRTXT"))))
(setq inc (sslength ss1))
(repeat inc      
(foreach att (vlax-invoke (vlax-ename->vla-object (ssname SS1 (setq inc (1- inc)) )) 'getattributes)
(if (= oldtag1 (strcase (vla-get-tagstring att)))
(vla-put-textstring att newstr1) 
) ; end if
(if (= oldtag2 (strcase (vla-get-tagstring att)))
(vla-put-textstring att newstr2) 
) ; end if
) ; end for
) ;end repeat

(setq oldtag1 "REV-NO")
(setq newstr1 "0")

(ddmmyy)
(setq oldtag2 "DATE") ; attribute tags
(setq newstr2 date)
(setq oldtag3 "AMENDMENT")
(setq newstr3 "ISSUED FOR CONSTRUCTION")
; revtable is block name
(setq ss2 (ssget "x"  '((0 . "INSERT") (2 . "REVTABLE"))))
(setq inc (sslength ss2))
(repeat inc
(foreach att (vlax-invoke (vlax-ename->vla-object (ssname ss2 (setq inc (1- inc)))) 'getattributes)
(if (= oldtag1 (strcase (vla-get-tagstring att)))
(vla-put-textstring att newstr1) 
)
(if (= oldtag2 (strcase (vla-get-tagstring att)))
(vla-put-textstring att newstr2) 
)
(if (= oldtag3 (strcase (vla-get-tagstring att)))
(vla-put-textstring att newstr3) 
)
)
)

(setq ss1 nil)
; (setq ss2 nil)
(princ)

[pBe]

Looks interesting to code

[steven-g]

As a starting point I would add a couple of extra attributes (these could be set as invisible), the first to record each layout name so you can get a list of existing layouts (using the "ctab" variable), the second would register the block insertion point Y value so you can find the highest value (insertion point is a block placeholder option). It is probably a lot easier using LISP in full Autocad but in LT I could use the "attext" command to extract that data from the blocks in all layouts and then in excel it would be much easier to sort and organise that list into some order for use in a data form (at least easier for me ), inserting new blocks could then be done using a script created in excel cells and pasted into the Autocad command line;

[BIGAL]

My $0.05 if you insert a rev block that has multiple lines in it but with blank info then you just check to see where an empty line is and fill out, its look is all done. You can check attributes by their created order rather than using a tag the advantage with this is you do not need to know hardly anything about the block basically just its name. As per original post though it creates line work as well a bit extra work.

[pBe]

Will be there an instance where a sheet on one or more of the layout tabs will not be REV-ED up?

 

It appears you already had a DCL at the ready, can you post it here? it saves us a lot of time creating one from scratch

 

[EDIT] Oops, the dialog posted in not a DCL isn't it?

Edited January 6, 2016 by pBe

[Fett2oo5]

Will be there an instance where a sheet on one or more of the layout tabs will not be REV-ED up?

Yes, in fact, it is more likely that any given change to the project will not affect all the sheets. It could affect 1 sheet or all but 1 sheet. This is why I wanted the options in magenta in the dialog box example.

 

I received some help from Ronjonp over at TheSwamp:

It will insert another RevBlock above the previous one, on all layout tabs. So it's a big step in the right direction.

(defun c:revs ;; Localized variables & functions
      (/ _dxf _copy _getattval _setattval blks co o rev ss)
 (vl-load-com)
 ;; < / Helper functions
 (defun _dxf (code ename)
   (if	(and ename (= (type ename) 'ename))
     (cdr (assoc code (entget ename '("*"))))
   )
 )
 (defun _getattval (block tag / att out)
   (foreach att (vlax-invoke block 'getattributes)
     (if (eq (strcase tag) (strcase (vla-get-tagstring att)))
(setq out (vla-get-textstring att))
     )
   )
   out
 )
 (defun _setattval (block tag value / att out)
   (foreach att (vlax-invoke block 'getattributes)
     (if (eq (strcase tag) (strcase (vla-get-tagstring att)))
(setq out (vla-put-textstring att value))
     )
   )
   out
 )
 (defun _copy (obj from to / out)
   (cond ((setq out (vlax-invoke obj 'copy)) (vlax-invoke out 'move from to) (vla-update out) out))
 )
 ;; Helper functions \ >
 ;; 
 ;; Foreach paperspace tab
 (foreach tab (layoutlist)
   ;; If we find 'revblk'(s) on that tab
   (if	(and (setq ss (ssget "_X" (list '(0 . "insert") (cons 410 tab) '(2 . "RevBlk"))))
     ;; Convert the selection set to a list
     (setq ss (mapcar 'cadr (ssnamex ss)))
     ;; Sort the blocks by greatest Y value & grab the first item
     (setq ss (car (vl-sort ss '(lambda (a b) (> (caddr (_dxf 10 a)) (caddr (_dxf 10 a)))))))
     ;; Add the first item ( greatest Y ) to a 'blks' list
     (setq blks (cons ss blks))
)
     ;; Iterate the 'blks' list
     (foreach blk blks
(if (and ;; Convert block from 'ename' to vla-object
	 (setq o (vlax-ename->vla-object blk))
	 ;; Make a copy + 0.127148 in the Y
	 (setq co (_copy o '(0.0 0.0 0.0) '(0.0 0.127148 0.0)))
    )
  (progn ;; Check that the att value is a number
	 (or (and (setq rev (_getattval o "R#"))
		  (numberp (read rev))
		  ;; Increment the value by 1
		  (setq rev (itoa (1+ (atoi rev))))
	     )
	     ;; Or set it to 0
	     (setq rev "0")
	 )
	 ;; Set new attribute values in the copied block
	 (_setattval co "R#" rev)
	 (_setattval co "REVl1" (strcat "DESCRIPTION FOR REV - " rev))
	 (_setattval co "REVB" "YODA")
	 (_setattval co "REVD" (menucmd "M=$(edtime,$(getvar,date),M\"/\"YY)"))
  )
)
     )
   )
 )
 (princ)
)

However it seems to place # amount of blocks on top of each other, above the existing revision block. And # looks to be the number of layout tabs there are.

[BIGAL]

Pbe re dcl maybe look at the layouts as a dcl scroll list but display the name and current revison bit like a dotted pair. Pick one and enables the single edit boxes. Thinking a bit more maybe Layoutname current-rev newrev in listbox, then a update button, so you can scroll up and own before actually doing the changes. The third bit like 1st update all is to update range.

 

[pBe]

Did you modify the original code from ronjonp? I'm pretty sure its not written that way. I would suggest you check the original post at TheSwamp

 

(defun c:revs ;; Localized variables & functions
      (/ _dxf _copy _getattval _setattval blks co o rev ss)
 (vl-load-com)
 ;; < / Helper functions
 (defun _dxf (code ename)
   (if (and ename (= (type ename) 'ename))
     (cdr (assoc code (entget ename '("*"))))
   )
 )
 (defun _getattval (block tag / att out)
   (foreach att (vlax-invoke block 'getattributes)
     (if (eq (strcase tag) (strcase (vla-get-tagstring att)))
(setq out (vla-get-textstring att))
     )
   )
   out
 )
 (defun _setattval (block tag value / att out)
   (foreach att (vlax-invoke block 'getattributes)
     (if (eq (strcase tag) (strcase (vla-get-tagstring att)))
(setq out (vla-put-textstring att value))
     )
   )
   out
 )
 (defun _copy (obj from to / out)
   (cond ((setq out (vlax-invoke obj 'copy)) (vlax-invoke out 'move from to) (vla-update out) out))
 )
 ;; Helper functions \ >
 ;; 
 ;; Foreach paperspace tab
 (foreach tab (layoutlist)
   ;; If we find 'revblk'(s) on that tab
   (if (and (setq ss (ssget "_X" (list '(0 . "insert") (cons 410 tab) '(2 . "RevBlk"))))
     ;; Convert the selection set to a list
     (setq ss (mapcar 'cadr (ssnamex ss)))
     ;; Sort the blocks by greatest Y value & grab the first item
     (setq ss (car (vl-sort ss '(lambda (a b) (> (caddr (_dxf 10 a)) (caddr (_dxf 10 a)))))))
     ;; Add the first item ( greatest Y ) to a 'blks' list
     [color=blue];(setq blks (cons ss blks))[/color]
[color=blue] )[/color]
     ;; Iterate the 'blks' list
     ;;(foreach blk blks
(if (and ;; Convert block from 'ename' to vla-object
  (setq o (vlax-ename->vla-object ss))
  ;; Make a copy + 0.127148 in the Y
  (setq co (_copy o '(0.0 0.0 0.0) '(0.0 0.127148 0.0)))
    )
  (progn ;; Check that the att value is a number
  (or (and (setq rev (_getattval o "R#"))
    (numberp (read rev))
    ;; Increment the value by 1
    (setq rev (itoa (1+ (atoi rev))))
      )
      ;; Or set it to 0
      (setq rev "0")
  )
  ;; Set new attribute values in the copied block
  (_setattval co "R#" rev)
  (_setattval co "REVl1" (strcat "DESCRIPTION FOR REV - " rev))
  (_setattval co "REVB" "YODA")
  (_setattval co "REVD" (menucmd "M=$(edtime,$(getvar,date),M\"/\"YY)"))
  )
)
     )
   )
)
 (princ)
)

That will take care of the "Insert New Revisions on All Tabs"

 

As for the other thing......well... DCL and all.....

[pBe]

....Pick one and enables the single edit boxes. Thinking a bit more maybe Layoutname current-rev newrev in listbox, then a update button, so you can scroll up and own before actually doing the changes....

 

Sounds like a plan, all we need now is somebody to start building the dialog box. we will add options to ronjonp's program. Easy cheesy.

[Tharwat]

Have a play with this program that I have just finished from writing it for you for sure so try it and let me know.

 

Firstly add the following DCL into your support folder then run the program .

 

(defun c:rev (/ doc id _atts ln l obj ls mx bk lst lays dwg tags mk new
             at atts d r rv nlst
            )
 ;;---------------------------------------;;
 ;; Author : Tharwat Al Shoufi            ;;
 ;; Cadtutor.com - Date: 07. Jan. 2016    ;;
 ;;---------------------------------------;;
 (if (not (and (setq id (load_dialog "AddNewRev.dcl"))
               (new_dialog "tmp" id)
          )
     )
   (alert
     "DCL file <AddNewRev> is not found or can't be loaded !"
   )
   (progn
     (defun _getatts (b / l)
       (mapcar '(lambda (a)
                  (setq l
                         (cons (list (vla-get-tagstring a) (vla-get-textstring a))
                               l
                         )
                  )
                )
               (vlax-invoke b 'getattributes)
       )
       l
     )
     (setq doc (vla-get-activedocument (vlax-get-acad-object)))
     (vlax-for layouts (vla-get-layouts doc)
       (if (/= (setq ln (vla-get-name layouts)) "Model")
         (progn
           (setq l nil)
           (vlax-for obj (vla-get-block layouts)
             (if
               (and (eq (vla-get-objectname obj) "AcDbBlockReference")
                    (eq (vla-get-name obj) "RevBlk")
               )
                (setq l
                       (cons (cons (cadr (vlax-get obj 'insertionpoint)) obj)
                             l
                       )
                )
             )
           )
           (if l
             (setq ls  (mapcar 'car l)
                   mx  (apply 'max ls)
                   bk  (cdr (assoc mx l))
                   lst (cons (list ln bk (_getatts bk)) lst)
             )
           )
         )
       )
     )
     (if lst
       (progn
         (setq lays (mapcar 'car lst))
         (start_list "lays")
         (mapcar 'add_list lays)
         (end_list)
         (set_tile "lays" "0")
       )
       (mode_tile "oki" 1)
     )
     (set_tile "Fname"
               (if (/= "" (setq dwg (vla-get-fullname doc)))
                 dwg
                 "Drawing is not yet saved !"
               )
     )
     (action_tile
       "oki"
       "(setq tags (read (strcat \"(\" (get_tile \"lays\")\")\")))(done_dialog)"
     )
     (action_tile "esc" "(done_dialog)")
     (start_dialog)
     (unload_dialog id)
   )
 )
 (if tags
   (progn
     (mapcar '(lambda (p) (setq mk (cons (nth p lays) mk))) tags)
     (vla-startundomark doc)
     (vlax-for tab (vla-get-layouts doc)
       (if
         (and (member (vla-get-name tab) mk)
              (vl-some
                '(lambda (x)
                   (and (eq (car x) (vla-get-name tab)) (setq nlst x))
                 )
                lst
              )
         )
          (if (vlax-write-enabled-p (cadr nlst))
            (progn
              (vlax-invoke
                (setq new (vlax-invoke (cadr nlst) 'copy))
                'move
                '(0. 0. 0.)
                '(0. 0.127148 0.)
              )
              (vla-update new)
              (setq atts
                     (mapcar '(lambda (x) (cons (vla-get-tagstring x) x))
                             (vlax-invoke new 'getattributes)
                     )
              )
              (if
                (and
                  (vl-some '(lambda (x)
                              (and (= "R#" (car x)) (setq r (cdr x)))
                            )
                           atts
                  )
                  (vl-some '(lambda (x)
                              (and (= "REVL1" (car x)) (setq d (cdr x)))
                            )
                           atts
                  )
                )
                 (cond
                   ((numberp (setq rv (read (vla-get-textstring r))))
                    (vla-put-textstring r (itoa (1+ rv)))
                    (vla-put-textstring
                      d
                      (strcat "DESCRIPTION FOR REV - " (itoa (1+ rv)))
                    )
                   )
                   ((eq (vla-get-textstring r) "A")
                    (vla-put-textstring r "B")
                    (vla-put-textstring d "REVISED PER CUSTOMER REQUEST")
                   )
                   (t
                    (vla-put-textstring r "0")
                    (vla-put-textstring d "ISSUED FOR CONSTRUCTION")
                   )

                 )
              )
              (if
                (vl-some '(lambda (x)
                            (and (= "REVD" (car x)) (setq at (cdr x)))
                          )
                         atts
                )
                 (vla-put-textstring
                   at
                   (menucmd "M=$(edtime,$(getvar,date),M\"/\"YY)")
                 )
              )
            )
            (princ (strcat "\nRevBlk in layout < "
                           (vla-get-name tab)
                           " > might be on Locked Layer !!"
                   )
            )
          )
       )
     )
     (vla-endundomark doc)
   )
 )
 (princ)
)(vl-load-com)

@pBe happy to see posting again .

AddNewRev.DCL

[pBe]

...

@pBe happy to see posting again .

 

I'm glad to be seen.

[Fett2oo5]

Well my new friends, I've got some bad news.

 

I was told I am going to be laid off. I'm to finish my current design/engineering projects and after about 2 weeks I'll need to find a new employer.

 

So I won't be able to put much attention (if any) on this project for a little bit. If you are interested in this project please subscribe to it.

 

As for this project thread, I'm going to make the DCL that I was referencing in the OP, and then we could go from there?

 

Thank you for the help so far. I'm not going to give up on this project thread, but I can not devote the time to it in the next few weeks as I hoped I could.

Know that I will be coming back to this project I feel it is to versatile and useful to let it die.

 

I hope to be back posting soon.

[satdog]

Hallo Tharwat!

 

Very nice, trying to get it to work like in the picture but with no luck, can you help me ?

 

My whises would be through the DCL interface type in the new values for "description" and "signature" and "date" but that is over my skills!

 

Thanks

Anders, Sweden

[Tharwat]

Hi Anders,

 

Hallo Tharwat!

 

Very nice, trying to get it to work like in the picture but with no luck, can you help me ?

 

Thanks , the program works as per the OP's requirements in this thread, and you are talking about something almost entirely different.

 

My whises would be through the DCL interface type in the new values for "description" and "signature" and "date" but that is over my skills!

 

Are you after a program with DCL to change attribute text strings as per their tag strings with three attributes: description, signature and date?

 

Should the program change a specific attributed block name in all layouts ? or in layouts that should be selected / picked by the user in a list as in the previous DCl program in this thread ?

[pBe]

..Well my new friends, I've got some bad news..

 

 

Sad, anyhow, if you still want to pursue this then go ahead and post that DCL.

[Andrew1979]

I wrote something very similar to this. My version would need to be altered quite a lot though to suit your titleblocks but it can be done. It was a massive amount of work to do. I used LISP and DCL as mentioned.

DCL

TBDCL : dialog {
         label = "Update Titleblock";
         : column {//start column
:boxed_row {
              : list_box {
               label ="Choose layouts";
               key = "mylist1key";
               height = 20;
               width = 30;
       multiple_select = true;
               //value = "0";
             }

:boxed_column {
             : popup_list {
               key = "REVLETTERSlist";
               label = "Revision Number";
               fixed_width_font = true;
               width = 30;
               value = "";

             }  







:row {
//label = "Titleblock Date";
             : toggle {
               key = "TogTBdate";
               label = "";
                value = "0"; 
             } 

             : edit_box {
               key = "eb1";
               label = "Enter Titleblock Date:";
               edit_width = 20;
               value = "";
             }
}



:row {

             : toggle {
               key = "TogDescription";
               label = "";
                value = "0"; 
             } 

             : edit_box {
               key = "Description";
               label = "Enter Revision Description:";
               edit_width = 20;
               value = "";
             }
}


:row {

             : toggle {
               key = "TogRevDate";
               label = "";
                value = "0"; 
             } 

             : edit_box {
               key = "RevDate";
               label = "Enter Revision Date:";
               edit_width = 20;
               value = "";
             }
}





:row {
             : toggle {
               key = "TogRevInit";
               label = "";
                value = "0"; 
             } 

             : edit_box {
               key = "RevInit";
               label = "Enter Revision Initial:";
               edit_width = 20;
               value = "";
             }

}


}
   }            //  label = "Enter New Values";

}

                   //end list






      : row {
             : button {
            width = 10;
            fixed_width = true;
               key = "accept";
               label = " Okay ";
               is_default = true;
             }
             : button {
             width = 10;
            fixed_width = true;
               key = "cancel";
               label = " Cancel ";
               is_default = false;
               is_cancel = true;
             }

           }
 
          
    


         : errtile
   {
   width = 34;
   }
}

 

LISP

(defun CANCEL ()
(done_dialog)
 (exit)
)





(defun SaveVar ()
 (cond
   ((= (get_tile "mylist1key") "0") (LM:Popup "Error!" "Please select a layout" (+ 1 64 4096)) ); (start) (done_dialog))
   ;((get_attr "mylist1key" "0") (LM:Popup "Error!" "Please select a layout" (+ 1 64 4096)) (start) (done_dialog))
   ((> (get_tile "mylist1key") "0") (ProcessList)); (start) (done_dialog))
   
   ; (set_tile "error" "You must Select a Layout")
   ;(mode_tile "mylist1key" 2)
)(ProcessList)
 )


(defun ProcessList ()

 ;;;--- Save the list setting
 (setq readlist(get_tile "mylist1key"))

 
 (setq readlistREVS(get_tile "REVLETTERSlist"))
 ;(setq readlistREVS (atoi readlistREVS))
 ;(setq readlistREVS (itoa readlistREVS))
 ;(setq myItem2 (nth "1" REVLETTERSlist))
(setq myItem2 "A")
(done_dialog)
)



(defun C:tbae()
(setq OldCMDecho (getvar "CMDECHO"))
(setq NewCMDecho (setvar "CMDECHO" 0))
 (start)
 (main)
 
)

(defun start ()
 ;(unload_dialog)
; (setq myList1(list "Electrical" "Structural" "Plumbing" "Foundation"))
   (setq myList(layoutlist))
   (setq Nothing "<Select>")
   (setq mylist1 (reverse mylist))
   (setq myList1(append myList1(list Nothing)))
   (setq mylist1 (reverse mylist1))

   (setq REVLETTERSlist (list "-" "A" "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "L" "M" "N" "O" "P" "Q" "R" "S" "T"));setq



 ;;;--- Load the dcl file from disk into memory
 (if(not(setq dcl_id (load_dialog "TBDCL.dcl")))
   (progn
     (alert "The DCL file could not be loaded!")
     (exit)
   )

   ;;;--- Else, the DCL file was loaded
   (progn

     ;;;--- Load the definition inside the DCL file
     (if (not(new_dialog "TBDCL" dcl_id))
       (progn
       (alert "Titleblock Editor could not be loaded!")
         (exit)
       )



       ;;;--- Else, the definition file was loaded
       (progn
     
         (start_list "mylist1key" 3)
         (mapcar 'add_list myList1)
         (end_list)

  
      (start_list "REVLETTERSlist" 3)                ;start the list box
       (mapcar 'add_list REVLETTERSlist)                ;fill the list box
       (end_list)
         ;;;--- If an action event occurs, do this function
     
     
(action_tile "eb1" "(setq eb1 $value)");title block date

(action_tile "REVLETTERSlist" "(setq REVLETTERSlist $value)");rev
     
(action_tile "Description" "(setq Description $value)");rev
(action_tile "RevDate" "(setq RevDate $value)");rev
(action_tile "RevInit" "(setq RevInit $value)");rev

(set_tile "Description" "Enter Description")
(mode_tile "Description" 2)


(set_tile "TogDescription" "Enter Description")      


     (action_tile "TogTBdate" "(setq TogTBdate $value)");rev

     (action_tile "TogDescription" "(setq TogDescription $value)");rev

     (action_tile "TogRevDate" "(setq TogRevDate $value)");rev

     (action_tile "TogRevInit" "(setq TogRevInit $value)")
     
         (action_tile "accept" "(SaveVar)")
         (action_tile "cancel" "(CANCEL)")

         ;;;--- Display the dialog box
         (start_dialog)

         ;;;--- Unload the dialog box
         (unload_dialog dcl_id)

       ;  ;;;--- If the user pressed the Cancel button
   

         ;;;--- If the user pressed the Okay button
;;;--- If the user pressed the Okay button
 
)))
)
)

(defun main ()  
  
(setq ListNumber (length retList2))
(setq no 0)

(setq bname "Title Block")
(setq attag "DATE")
(setq revtag "REV_NO.")

     ;(setq RevCasePositionk readlistREVS)
;(setq RevCasePosition (atoi serialchk))
;(setq Pos1x
;(setq Pos2x
     
;(setq eb1 (strcase eb1))
(if
(= TogDescription "1")
(setq Description (strcase Description))
)



   (command "-STYLE" "ROMANS1" "ROMANS" "1" "1" "0" "N" "N" "N")

   (setq CurrentCtab (getvar "CTAB"))




(repeat ListNumber
(ProgressBar "" "Processing calculations..." 0.5)
(repeat ListNumber (Progress))

(EndProgressBar)


 
   (setq nthretlist (nth no retlist2))

   (command "CTAB" nthretlist)
   ;(setvar "CTAB" nthretlist)



   
   (setq no (+ no 1))
   (setq ListNumber (- ListNumber 1))


         (cond   ((= myItem2 "A")
   (TextRevisions)
         )
       
   
             ((= myItem2 "B")
   ;(command "circle" "0,0,0" "d" "25")
   (TextRevisions)
         )
   
             ((= myItem2 "C")
   ;(command "circle" "0,0,0" "d" "25")
   (TextRevisions)
         )
     
             ((= myItem2 "D")
   (TextRevisions)
         )
   
             ((= myItem2 "E")
   (TextRevisions)
         )
     
             ((= myItem2 "F")
   (TextRevisions)
         )
     
             ((= myItem2 "G")
   (TextRevisions)
         )
       
             ((= myItem2 "H")
   (TextRevisions)
         )
     
             ((= myItem2 "I")
   (TextRevisions)
         )
             
             ((= myItem2 "J")
   (TextRevisions)
         )
             
             ((= myItem2 "K")
   (TextRevisions)
         )
             
             ((= myItem2 "L")
   (TextRevisions)
         )
             
             ((= myItem2 "M")
   (TextRevisions)
         )
             
             ((= myItem2 "N")
   (TextRevisions)
         )
             
             ((= myItem2 "O")
   (TextRevisions)
         )
             
             ((= myItem2 "P")
   (TextRevisions)
         )
     
             ((= myItem2 "Q")
   (TextRevisions)
         )
             
             ((= myItem2 "R")
   (TextRevisions)
         )
             
             ((= myItem2 "S")
   (TextRevisions)
         )
             
             ((= myItem2 "T")
   (TextRevisions)
         )        
       )




 
   (Setq a 0 ss (ssget "_x" (list (cons 0 "INSERT") (cons 2 bname) (cons 66 1) (cons 410 (getvar "CTAB"))) ))
   (repeat (sslength ss)

       (changeAttribValue2 (ssname ss a) revtag REVISIONlist REVISIONlist)


(if
(= TogTBDate "1");Date
(progn
;(setq eb1 (strcase eb1))
(changeAttribValue (ssname ss a) attag eb1 eb1)
(setq Test1 "TESTING")
)
)
   (setq a (1+ a))

);end repeat

)
;(EndProgressBar)


(setvar "ctab" CurrentCtab)
(setvar "CMDECHO" OldCMDecho)    
)
  
 





(defun changeAttribValue (ent attag oldval newval / entl)
 (while (and ent (/= "SEQEND" (cdr (assoc 0 (setq entl (entget ent))))))
   (and (= attag (cdr (assoc 2 entl)))
        (= oldval (cdr (assoc 1 entl))) ;<- could use WCMATCH instead
        (entmod (subst (cons 1 eb1) (assoc 1 entl) entl))
        (entupd ent)
        ;(mapcar 'princ (list "\n" bname " -> " attag))
   )
   (setq ent (entnext ent))
 )
)



(defun changeAttribValue2 (ent revtag oldval newval / entl)
;(setq REV myItem2)
 
 (while (and ent (/= "SEQEND" (cdr (assoc 0 (setq entl (entget ent))))))
   (and (= revtag (cdr (assoc 2 entl)))
        (= oldval (cdr (assoc 1 entl))) ;<- could use WCMATCH instead
        (entmod (subst (cons 1 myItem2) (assoc 1 entl) entl))
        (entupd ent)
        ;(mapcar 'princ (list "\n" bname " -> " myItem2))
   )
   (setq ent (entnext ent))
 )
)




;|
 (defun *error* (msg)
   (setq msg "Program Terminated.....")
 (princ "Alert: ")
 (princ msg)
(princ)
)
|;


 (defun LM:Popup ( title msg flags / wsh res )
   (if (setq wsh (vlax-create-object "wscript.shell"))
       (progn
           (setq res (vl-catch-all-apply 'vlax-invoke-method (list wsh 'popup msg 0 title flags)))
           (vlax-release-object wsh)
           (if (null (vl-catch-all-error-p res))
               res
           )
       )
   )
)






;(defun processIP ()
;(if (setq sel (ssget "_X" (list '(0 . "INSERT") '(2 . "Title Block") '(66 . 1) (cons 410 (getvar 'ctab)))))
;    (setq ins (cdr (assoc 10 (entget (ssname sel 0)))))


 
;(Setq aaa (ssget "_x" (list (cons 0 "INSERT") (cons 2 "Title Block") (cons 66 1)(cons 410 (getvar "CTAB"))) ))
;(Setq aaa (ssget "_X" '((0 . "INSERT") (66 . 1) (2 . "Title Block") (410 . (getvar "CTAB")))))
;(setq ent1 (entlast)) 
;(setq ent2 (entget ent1))

;(setq en (entget ent1))
;(setq ins (assoc 10 en)) 
 
;(setq ip (assoc 10 aaa))
;(setq ip2 (assoc 10 ip))  
;(setq ip3 (car ip2))
;(setq ip4 (cadr ip2))  
 ;(command "point" ip)
   







(defun TextRevisions ()
;(processIP)
(if (setq sel (ssget "_X" (list '(0 . "INSERT") '(2 . "Title Block") '(66 . 1) (cons 410 (getvar 'ctab)))))
   (setq ins (cdr (assoc 10 (entget (ssname sel 0)))))
)
   (setq IPx (car ins))
   (setq IPy (cadr ins))
     ;(setq IPz (caddr INS))
 
(cond
      ((= myItem2 "-")
   (setq Posy (+ IPy 276.2))
   (setq Pos1x (- IPx 50.)
   (setq Pos2x (- IPx 47.6))
   (setq Pos3x (- IPx 12.7))
   (setq Pos4x (- IPx 3.4))
   (setq Pos1 (strcat Pos1x "," Posy))
   (setq Pos2 (strcat Pos2x "," Posy))
   (setq Pos3 (strcat Pos3x "," Posy))
   (setq Pos4 (strcat Pos4x "," Posy));(setq Pos4Length (strlen Pos4))(setq Pos4LengthMinus1 (- Pos4Length 1))(setq Pos4 (substr Pos4 2 Pos4LengthMinus1))
   (setq RevChar "-")
   )
      
      ((= myItem2 "A")(setq Pos1 "351.3,277.7")(setq Pos2 "354.9,277.7")(setq Pos3 "390.1,277.7")(setq Pos4 "399.0,277.7") (setq RevChar "A"))
      ((= myItem2 "B")(setq Pos1 "351.3,280.3")(setq Pos2 "354.9,277.7")(setq Pos3 "390.1,277.7")(setq Pos4 "399.0,277.7") (setq RevChar "B"))
      ((= myItem2 "C")(setq Pos1 "351.3,280.3")(setq Pos2 "354.9,277.7") (setq RevChar "C"))
      ((= myItem2 "D")(setq Pos1 "351.3,280.3")(setq Pos2 "354.9,277.7") (setq RevChar "D"))
      ((= myItem2 "E")(setq Pos1 "351.3,280.3")(setq Pos2 "354.9,277.7") (setq RevChar "E"))
      ((= myItem2 "F")(setq Pos1 "351.3,280.3")(setq Pos2 "354.9,277.7") (setq RevChar "F"))
      ((= myItem2 "G")(setq Pos1 "351.3,280.3")(setq Pos2 "354.9,277.7") (setq RevChar "G"))
      ((= myItem2 "H")(setq Pos1 "351.3,280.3")(setq Pos2 "354.9,277.7") (setq RevChar "H"))
      ((= myItem2 "I")(setq Pos1 "351.3,280.3")(setq Pos2 "354.9,277.7") (setq RevChar "I"))
      ((= myItem2 "J")(setq Pos1 "351.3,280.3")(setq Pos2 "354.9,277.7") (setq RevChar "J"))
      ((= myItem2 "K")(setq Pos1 "351.3,280.3")(setq Pos2 "354.9,277.7") (setq RevChar "K"))
      ((= myItem2 "L")(setq Pos1 "351.3,280.3")(setq Pos2 "354.9,277.7") (setq RevChar "L"))
      ((= myItem2 "M")(setq Pos1 "351.3,280.3")(setq Pos2 "354.9,277.7") (setq RevChar "M"))
      ((= myItem2 "N")(setq Pos1 "351.3,280.3")(setq Pos2 "354.9,277.7") (setq RevChar "N"))
      ((= myItem2 "O")(setq Pos1 "351.3,280.3")(setq Pos2 "354.9,277.7") (setq RevChar "O"))
      ((= myItem2 "P")(setq Pos1 "351.3,280.3")(setq Pos2 "354.9,277.7") (setq RevChar "P"))
      ((= myItem2 "Q")(setq Pos1 "351.3,280.3")(setq Pos2 "354.9,277.7") (setq RevChar "Q"))
      ((= myItem2 "R")(setq Pos1 "351.3,280.3")(setq Pos2 "354.9,277.7") (setq RevChar "R"))
      ((= myItem2 "S")(setq Pos1 "351.3,280.3")(setq Pos2 "354.9,277.7") (setq RevChar "S"))
      ((= myItem2 "T")(setq Pos1 "351.3,280.3")(setq Pos2 "354.9,277.7") (setq RevChar "T"))
)


 
(if
(= TogRevDate "1")
(progn
   (command "text" "j" "tl" Pos1 "0" myItem2);Revision REV
 )
)

 
(if
(= TogDescription "1")
(progn
 (setq Description (strcase Description))
   (command "text" "j" "tl" Pos2 "0" Description);Revision Description
 )
)

 
(if
(= TogRevDate "1")
(progn
 (setq RevDate (strcase RevDate))
   (command "text" "j" "tl" Pos3 "0" RevDate);Revision Date
 )
)  


 (if
(= TogRevInit "1")
(progn
(setq RevInit (strcase RevInit))  
   (command "text" "j" "tl" Pos4 "0" RevInit);Revision Initals
 )
)
 

);end Defun

























(defun ProgressBar (Title$ Message$ Delay~)
 (setq *Delay~ Delay~)
 (if (not *Speed#) (Speed))
 (setq *Dcl_Id% (load_dialog "ProgressBar.dcl"))
 (new_dialog "ProgressBar" *Dcl_Id%)
 (if (= Title$ "")(setq Title$ "AutoCAD Message"))
 (if (= Message$ "")(setq Message$ "Processing information..."))
 (set_tile "Title" (strcat " " Title$))
 (set_tile "Message" Message$)
 (setq *X# (1- (dimx_tile "ProgressBar")))
 (setq *Y# (1- (dimy_tile "ProgressBar")))
 (start_image "ProgressBar")
 (vector_image 0 2 2 0 
 (vector_image 2 0 (- *X# 2) 0 
 (vector_image (- *X# 2) 0 *X# 2 
 (vector_image *X# 2 *X# (- *Y# 2) 
 (vector_image (- *X# 2) *Y# *X# (- *Y# 2) 
 (vector_image (- *X# 2) *Y# 2 *Y# 
 (vector_image 2 *Y# 0 (- *Y# 2) 
 (vector_image 0 (- *Y# 2) 0 2 
 (end_image)
 (setq *Inc# 0 *Xpt# -4)
 (princ)
);defun ProgressBar
;-------------------------------------------------------------------------------
; Progress - Move the Progress Bar
;-------------------------------------------------------------------------------
(defun Progress (/ Complete$)
 (setq *Inc# (1+ *Inc#))
 (if (= (rem *Inc# 2) 1)
   (setq *Xpt# (+ *Xpt# 7))
 );if
 (start_image "ProgressBar")
 (if (> *Inc# 100)
   (progn
     (setq *Inc# 0 *Xpt# -4)
     (start_image "ProgressBar")
     (fill_image 3 3 (- *X# 5) (- *Y# 5) -15)
   );progn
   (progn
     (vector_image *Xpt#  3 (+ *Xpt# 4)  3 120)
     (vector_image *Xpt#  4 (+ *Xpt# 4)  4 110)
     (vector_image *Xpt#  5 (+ *Xpt# 4)  5 110)
     (vector_image *Xpt#  6 (+ *Xpt# 4)  6 100)
     (vector_image *Xpt#  7 (+ *Xpt# 4)  7 100)
     (vector_image *Xpt#  8 (+ *Xpt# 4)  8  90)
     (vector_image *Xpt#  9 (+ *Xpt# 4)  9  90)
     (vector_image *Xpt# 10 (+ *Xpt# 4) 10  90)
     (vector_image *Xpt# 11 (+ *Xpt# 4) 11  90)
     (vector_image *Xpt# 12 (+ *Xpt# 4) 12 100)
     (vector_image *Xpt# 13 (+ *Xpt# 4) 13 100)
     (vector_image *Xpt# 14 (+ *Xpt# 4) 14 110)
     (vector_image *Xpt# 15 (+ *Xpt# 4) 15 110)
     (vector_image *Xpt# 16 (+ *Xpt# 4) 16 120)
   );progn
 );if
 (end_image)
 (setq Complete$ (strcat (itoa (fix (+ *Inc# 0.5))) "% Complete..."))
 (set_tile "Complete" Complete$)
 (delay *Delay~)
 (action_tile "cancel" "(done_dialog)(exit)")
 (if (= *Inc# 100)(delay 10));Delay to show complete
 (princ)
);defun Progress
;-------------------------------------------------------------------------------
; EndProgressBar - Close Progress Bar dialog and clear variables
;-------------------------------------------------------------------------------
(defun EndProgressBar ( )
 (setq *Delay~ (* *Delay~ 0.5));Speed up bars remaining
 (if (and (> *Inc# 0)(< *Inc# 100))
   (repeat (- 100 *Inc#) (Progress))
 );if
 (done_dialog)
 (start_dialog)
 (unload_dialog *Dcl_Id%)
 (setq *Dcl_Id% nil *Delay~ nil *Inc# nil *X# nil *Xpt# nil *Y# nil)
 (princ)
);defun EndProgressBar
;-------------------------------------------------------------------------------
; Speed - Determines the approximate computer processing speed and sets the
; global variable *speed# which may be used in delay loops while in dialogs.
;-------------------------------------------------------------------------------
(defun Speed (/ Cdate~ Cnt# NewSecond# OldSecond#)
 (setq Cdate~ (getvar "CDATE"))
 (setq NewSecond# (fix (* (- (* (- Cdate~ (fix Cdate~)) 100000)(fix (* (- Cdate~ (fix Cdate~)) 100000))) 10)))
 (repeat 2
   (setq Cnt# 0)
   (setq OldSecond# NewSecond#)
   (while (= NewSecond# OldSecond#)
     (setq Cdate~ (getvar "CDATE"))
     (setq NewSecond# (fix (* (- (* (- Cdate~ (fix Cdate~)) 100000)(fix (* (- Cdate~ (fix Cdate~)) 100000))) 10)))
     (setq Cnt# (1+ Cnt#))
   );while
 );repeat
 (setq *Speed# Cnt#)
 (princ)
);defun Speed
;-------------------------------------------------------------------------------
; delay - time delay function
; Arguments: 1
;   Percent~ - Percentage of *Speed# variable
; Returns: time delay
;-------------------------------------------------------------------------------
(defun delay (Percent~ / Number~)
 (if (not *Speed#) (Speed))
 (repeat (fix (* *Speed# Percent~)) (setq Number~ pi))
 (princ)
);defun delay

 

The myitem2 variable relates to the position of parts of the titleblock revisions which you would need to change.

[Tharwat]

I have my won program that I use it frequently to remove / add new revisions to a bunch of drawings or at current opened drawing or on both together.

 

Can not upload the image as .gif