We have a few hundred drawings that we need to change certain block attributes. We need to change the valve of the text in that attribute from whatever it is (doe snot matter what it is) to a specific text string.
For example:
If the attribute is called "name" and has the text string of ALAN in it in some drawing or BRUCE in other drawings, we want to chaneg all drawings to TOM.
Any help with a lisp routine would be appreciated.
Thanks
@alan1959 wrote:We have a few hundred drawings that we need to change certain block attributes. We need to change the valve of the text in that attribute from whatever it is (doe snot matter what it is) to a specific text string.
For example:
If the attribute is called "name" and has the text string of ALAN in it in some drawing or BRUCE in other drawings, we want to chaneg all drawings to TOM.
Any help with a lisp routine would be appreciated.
Thanks
QUESTION:
this might sound silly to you but, are these attribtues LEFT justified? it matters using ODBX wtih attribute editing but not for script.
Also we can narrow down if you supply the block name
Some of the attriubutes are LEFT justified while others are CENTER justified. The block name is TB-TEXT and an example of the attribute I want to change is TITLE_1 or LOCATION
Something like this may help
See comments within the code
divide this code on 2 files:
{code}
;;; ----------------------------- SCRPROC.lsp -------------------------------;;;
;;; you can save this file in any place
;;; 5/28/09
;;; edited 2/9/12
;;;-------------------------- Write and run script ----------------------------;;;
(defun C:SCRPROC(/ allfiles allfolders dwgname dwgs fn scrpath subfold x)
;; Files & Folders
;; Function to create a tree-structured list of folders
;; given the parent folder as a Path.
;; Note that using a path of "" or "." or "\\" will exclude
;; the drive letter. McNeel's DOSLIB has a DOS_FULLPATH function
;; that can return such folders with drive designations.
;; (c) John F. Uhden, Cadlantic
(defun @Folders (Path / Folders )
(defun @Dirs (Path / Dir Dirs)
(and
(= (type Path) 'STR)
;;; (or
;;; (/= (type DOS_FULLPATH) 'EXRXSUBR)
;;; (setq Path (DOS_FULLPATH Path))
;;; )
(if (wcmatch Path ",*/,*\\")
(setq Dir Path)
(setq Dir (strcat Path "\\"))
)
(setq Dirs (vl-directory-files Dir "*.*" -1))
(setq Folders (cons Path Folders))
(setq Dirs (vl-remove-if '(lambda (x)(vl-position x '("." ".."))) Dirs))
(mapcar '@Dirs (mapcar '(lambda (x)(strcat Dir x)) Dirs))
)
)
(@Dirs Path)
(reverse Folders)
)
;;;--------------------------- main part ------------------------;;;
(setq dwgname (getfiled "Select Drawing File" "" "dwg" 16))
(setq allfolders (@Folders (vl-filename-directory dwgname)))
(foreach subfold allfolders
(setq dwgs (vl-directory-files subfold "*.dwg" 1))
(if dwgs
(setq allfiles (append (mapcar '(lambda (x)(if(wcmatch subfold ",*/,*\\")
(strcat subfold x)
(strcat subfold "\\" x))
) dwgs)
allfiles)))
)
(setq scrpath (strcat (vl-filename-directory dwgname) "\\BatchAtt.scr"))
(setq fn (open scrpath "w"))(princ)
(foreach dwgpath allfiles
(write-line (strcat "_open \"" dwgpath "\"") fn)
(write-line "(C:SCA)" fn);;<--THIS MUST BE IN THE SEARCH PATH
(write-line "_redraw" fn)
(write-line (strcat "_.saveas \"" dwgpath "\"") fn);<--- DO NOT TOUCH THIS LINE!
(write-line "_close" fn)
(close fn)
(terpri)
(command "_.script" scrpath)
(princ)
)
(princ "\n\t--- Start commad with SCRPROC ---")
(prin1)
;;; ----------------------------- SCA.lsp -------------------------------;;;
;;; SCA.lsp save this file in the support path only, e.g in:
;;; (strcat (getvar "ROAMABLEROOTPREFIX") "Support")
;;; you can move it from this folder after the work is finished
;;;;; Note: you have to put this file in startup suite:
;;; Tools->AutoLIsp->Load Application->Startup suit / Contents->Add
;;; 2/9/12
(defun C:SCA (/ acapp adoc allfiles allfolders ;|att_data-global|; bname dwgname dwgs lt olayouts subfold tabs x)
(defun _getsortedtabs (/ tabs tabName)
(vlax-for Layout
(vla-get-Layouts
(vla-get-activedocument (vlax-get-acad-object))
)
(if
(/= (setq tabName (strcase (vla-get-name layout))) "MODEL")
(setq tabs (cons (cons (vla-get-taborder layout) tabName) tabs)
)
)
;;sort tabs
(setq tabs (vl-sort tabs '(lambda (lta ltb)(< (car lta)(car ltb)))))
)
(mapcar 'cdr tabs)
)
;; change block name here
(setq bname "TB-TEXT")
;;Change this list of pairs (tag . value) to your suit
(setq att_data (list
'("TITLE_1" . "VALUE OF TITLE_1 IS HERE")
'("LOCATION" . "VALUE OF LOCATION IS HERE")
;;add other pairs like this
'("MYTAG" . "VALUE OF MYTAG IS HERE")
;;;etc etc
))
(setq tabs (_getsortedtabs))
(setq acapp(vlax-get-acad-object))
(setq adoc (vla-get-activedocument acapp))
(setq olayouts (vla-get-Layouts adoc))
(vla-put-activespace adoc 0)
(foreach ltname tabs
(setq lt (vla-item olayouts ltname))
(vla-put-activelayout (vla-get-activedocument (vlax-get-acad-object)) lt)
(vla-zoomextents (vlax-get-acad-object));<-- zoom to extents every tab, optional
(vlax-for obj (vla-get-block lt)
(if (and (eq "AcDbBlockReference" (vla-get-objectname obj))
(eq bname (vla-get-effectivename obj))
)
(progn
(foreach attobj (vlax-invoke obj 'getattributes)
(foreach record att_data
;; use exact match:
(if (eq (car record) (vla-get-tagstring attobj))
(vla-put-textstring attobj (cdr record))
)
)
)
)
)
)
)
(setvar "tilemode" 1);<-- switch to model, optional
(vlax-release-object olayouts)
(vlax-release-object adoc)
(vlax-release-object acapp)
(princ)
)
(vl-load-com)
(princ)
{code}
~'J'~