change specific attributes to uppercase on multiple drawings

[Anonymous]

does anyone know of a lisp that will change specific attributes to uppercase on multiple drawings.

thanks

[dbhunia · Accepted solution]

Hi,

Try this........

First put all the drawings in a single folder & run the code it will ask to select the Folder Containing the drawings you just select the folder & move forward......Code will work itself on all the drawings in side that folder.....

But before running the Lisp make sure about two things-

       1. There is only one Drawing is open (other than any drawing which one you want to edit), otherwise SDI Variable can not be reset.

       2. Wait for complete execution of the command, otherwise SDI Variable will not restored back.

(defun c:CAV ( / sh folder folderobject result)
   (vl-load-com)
   (setq sh (vla-getInterfaceObject (vlax-get-acad-object) "Shell.Application" ))
   (setq folder (vlax-invoke-method sh 'BrowseForFolder 0 "" 0 ))
   (vlax-release-object sh)
   (setq SDI_Val (getvar "SDI"))
   (setq LISPI_Val (getvar "LISPINIT"))
   (vl-cmdf "SDI" 1)
   (vl-cmdf "LISPINIT" 0)
   (if folder
      (progn
         (setq folderobject (vlax-get-property folder 'Self))
         (setq result (vlax-get-property FolderObject 'Path))
         (vlax-release-object folder)
         (vlax-release-object FolderObject)

	(setq Files_Folder (vl-directory-files result "*.dwg"))
	(setq tag_str (getstring "\nEnter ATT Tag Name (it's case Sensitive): "))
	(command "save" (strcat (getvar "dwgprefix") (getvar "dwgname")) "Y")
	(setq n 0)

	(while (< n (length Files_Folder))

	(command "fileopen" (strcat result "\\" (nth n Files_Folder)))
	(vl-load-com)
  	(setq Att_Value "")
	(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
	(setq ss (ssget "X" (list '(0 . "INSERT"))))
	(cond ((/= ss nil)
	      (progn
		(repeat (setq NOS (sslength ss))
			(setq Data (ssname SS (setq NOS (- NOS 1))))
			(setq obj (vlax-ename->vla-object Data))
				(foreach att (vlax-invoke Obj 'GetAttributes)
				  (if (= (vla-get-Tagstring att) tag_str)
				      (progn
					(setq Att_Value (strcase (vla-get-Textstring att)))
					(vla-put-textstring att Att_Value)
				      )
				  );if
				);foreach
		);repeat
	      );progn
              )
	);cond
	(vl-cmdf "save" (strcat result "\\" (nth n Files_Folder)))
	(setq n (+ 1 n))
        );while
     )
   )
   (vl-cmdf "SDI" SDI_Val)
   (vl-cmdf "LISPINIT" LISPI_Val)
)

[Anonymous]

that worked awesome... you are brilliant.  thank  you very much for this.

[dbhunia]

Hi

This is an updated version..........You can try this......(with multiple Attribute Tag entries at once......)

(defun C:CAV ( / sh folder folderobject result)
   (vl-load-com)
   (setq sh (vla-getInterfaceObject (vlax-get-acad-object) "Shell.Application" ))
   (setq folder (vlax-invoke-method sh 'BrowseForFolder 0 "" 0 ))
   (vlax-release-object sh)
   (setq SDI_Val (getvar "SDI"))
   (setq LISPI_Val (getvar "LISPINIT"))
   (vl-cmdf "SDI" 1)
   (vl-cmdf "LISPINIT" 0)
   (if folder
      (progn
         (setq folderobject (vlax-get-property folder 'Self))
         (setq result (vlax-get-property FolderObject 'Path))
         (vlax-release-object folder)
         (vlax-release-object FolderObject)

	(setq Files_Folder (vl-directory-files result "*.dwg"))
	(setq tag_str (getstring T "\nEnter ATT Tag Names seperated by <-> (it's case Sensitive): "))
	(setq Att_Tag_lst (LM:str->lst tag_str "-"))
	(command "save" (strcat (getvar "dwgprefix") (getvar "dwgname")) "Y")
	(setq n 0)

	(while (< n (length Files_Folder))

	(command "fileopen" (strcat result "\\" (nth n Files_Folder)))
	(vl-load-com)
  	(setq Att_Value "")
	(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
	(setq ss (ssget "X" (list '(0 . "INSERT"))))
	(cond ((/= ss nil)
	      (progn
		(repeat (setq NOS (sslength ss))
			(setq Data (ssname SS (setq NOS (- NOS 1))))
			(setq obj (vlax-ename->vla-object Data))
				(foreach att (vlax-invoke Obj 'GetAttributes)
				    (repeat (setq N1 (length Att_Tag_lst))
					(setq Att_Tag (nth (setq N1 (- N1 1)) Att_Tag_lst))
					(if (= (vla-get-Tagstring att) Att_Tag)
				      	    (progn
						(setq Att_Value (strcase (vla-get-Textstring att)))
						(vla-put-textstring att Att_Value)
				      	    )
				  	);if
				    );repeat
				);foreach
		);repeat
	      );progn
              )
	);cond
	(vl-cmdf "save" (strcat result "\\" (nth n Files_Folder)))
	(setq n (+ 1 n))
        );while
     )
   )
   (vl-cmdf "SDI" SDI_Val)
   (vl-cmdf "LISPINIT" LISPI_Val)
)
(defun LM:str->lst ( str del / len lst pos )
    (setq len (1+ (strlen del)))
    (while (setq pos (vl-string-search del str))
	   (setq lst (cons (substr str 1 pos) lst))
           (setq str (substr str (+ pos len)))
    )
    (reverse (cons str lst))
)

[Anonymous]

even better yet.

thank you very much!

[Anonymous]

Hi dbhunia,  you have been so much help i hate to bother again but i have this small script file that i drop into my drawing and it swaps out the border with another one (see below).  I would like to take this one step farther and be able to change attibutes 'TITLE1, TITLE2 & TITLE3 to upper case at the same time.  Is this possible?   Thank you

-rename b
JRLOOP
temp
attreq 0
-insert "D:\DMS\rchsms014\Projects\RCH\Jobs\GP - Halsey\_site info\GPBLOOP.dwg"
10,0,0

erase l
-blockreplace "temp" GPBLOOP y

[Anonymous]

sorry i meant to say tag values instead of attribute.

[dbhunia]

Can you explain little more with a drawing file.......on marked one..... .

---

@Anonymous wrote:

Hi dbhunia,  you have been so much help i hate to bother again but i have this small script file that i drop into my drawing and it swaps out the border with another one (see below).  I would like to take this one step farther and be able to change attibutes 'TITLE1, TITLE2 & TITLE3 to upper case at the same time.  Is this possible?   Thank you

-rename b
JRLOOP
temp
attreq 0
-insert "D:\DMS\rchsms014\Projects\RCH\Jobs\GP - Halsey\_site info\GPBLOOP.dwg"
10,0,0

erase l
-blockreplace "temp" GPBLOOP y

---

[Anonymous]

here is the CAD file.  i would like to make the 3 line description uppercase when i drop my .scr file on the dwg.

[dbhunia · Accepted solution]

Hi

---

@Anonymous wrote:

Hi dbhunia,  you have been so much help i hate to bother again but i have this small script file that i drop into my drawing and it swaps out the border with another one (see below).  I would like to take this one step farther and be able to change attibutes 'TITLE1, TITLE2 & TITLE3 to upper case at the same time.  Is this possible?   Thank you

.......................

---

How far I believe in this world Nothing is IMPOSSIBLE .......... Only thing we have to explore things in proper way ..... But the thing matters which one is proper way ......

In my limited Knowledge in AutoCAD it is not possible directly to change to Upper Case through SCRIPT file using AutoCAD commands......

But the Execution Behavior of a SCRIPT file in AutoCAD is to Execute line by line (Start to End) whatever you entered into the file.......

So Accept this Behavior of SCRIPT file and place some Code of LISP from the last post into it and run it.......(Put this Below lines in your SCRIPT file)

Try this.......

;Put_this_lines_after_Your_Lines
;Change_Attribute_Values_to_Upper
(vl-load-com)
(setq Att_Tag_lst (list "TITLE1" "TITLE2" "TITLE3"));;Put_Attribute_Tag_Names_like_this_pattern_as_many_as_you_want....
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
(setq ss (ssget "X" (list '(0 . "INSERT"))))
(repeat (setq NOS (sslength ss))
(setq Data (ssname SS (setq NOS (- NOS 1))))
(setq obj (vlax-ename->vla-object Data))
(foreach att (vlax-invoke Obj 'GetAttributes)
(repeat (setq N1 (length Att_Tag_lst))
(setq Att_Tag (nth (setq N1 (- N1 1)) Att_Tag_lst))
(if (= (vla-get-Tagstring att) Att_Tag)
(progn
(setq Att_Value (strcase (vla-get-Textstring att)))
(vla-put-textstring att Att_Value)
);repeat
);if
);repeat
);foreach
);repeat
;Done

Or Create a separate SCRIPT file with the above code and run it....... It's tested in AutoCAD 2007 hopefully work in upper version.

Only problem in the above mentioned way is .................... All this Lisp Code will be visible in Command line history........

That also can be Resolved.......

[Anonymous]

that worked awesome.  you are the man.  thank you again.