Message 1 of 3
Update Titleblock Attribute of entire drawings in a directory sourcing csv
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hi guys,
I found a lisp routine by Lee-Mac in here and I tried and spend hours to combine it with other lisp routine to update titleblock attribute of entire drawings in a directory with values sourced from a CSV file.
Here is my two code but I lost to run main routine within sub-routine.
Briefly, main routine is prompting to select csv file and then update attribute values from csv file.
The second or sub-routine is also prompting to select drawings within a folder and I'm going to apply all this changes (run 1st routine) upon entire drawings within select directory.
I appreciate any help!
(vl-load-com)
(defun rat (adoc /
*error*
ano
bln bno
csv
ent
flg fnb:fun
inc
lst
sel str
tag
rat:blk rat:csv rat:ftr rat:lay
val
)
(setq rat:csv nil)
(setq rat:ftr nil)
(setq rat:lay t)
(setq rat:blk nil)
(defun *error* ( msg )
(AA:endundo (AA:acdoc))
(if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
(princ (strcat "\nError: " msg))
)
(princ)
)
(setq fnb:fun
(lambda ( s )
(if (wcmatch (strcase s t) "*.dwg,*.dxf,*.dwt,*.dws")
(vl-filename-base s) s
)
)
)
(cond
( (not (setq sel (ssget "_X" (vl-list* '(0 . "INSERT") '(66 . 1) (if rat:ftr (list (cons 2 (strcat "`*U*," rat:ftr))))))))
(princ "\nNo Attributed Blocks found in drawing.")
)
( (and rat:csv (not (setq csv (findfile rat:csv))))
(princ
(strcat
"\n"
(vl-filename-base rat:csv)
(vl-filename-extension rat:csv)
" not found."
)
)
)
( (and csv (/= ".CSV" (strcase (vl-filename-extension csv))))
(princ "\nAttribute data file must be in CSV format.")
)
( (not (or csv (setq csv (getfiled "Select CSV File" "" "csv" 16))))
(princ "\n*Cancel*")
)
( (not (setq lst (mapcar '(lambda ( x ) (cons (strcase (fnb:fun (car x))) (cdr x))) (AA:readcsv csv))))
(princ
(strcat
"\nNo data found in "
(vl-filename-base csv)
".csv file."
)
)
)
( (not
(setq tag (mapcar 'strcase (cdar lst))
lst (AA:massoc (strcase (fnb:fun (getvar 'dwgname))) lst)
)
)
(princ (strcat "\n" (fnb:fun (getvar 'dwgname)) " not found in first column of CSV file."))
)
( t
(setq lst (mapcar '(lambda ( x ) (mapcar 'cons tag x)) lst)
ano 0
bno 0
)
(AA:startundo (AA:acdoc))
(repeat (setq inc (sslength sel))
(setq ent (ssname sel (setq inc (1- inc)))
bln (strcase (AA:al-effectivename ent))
val lst
flg nil
)
(if (or (null rat:ftr) (wcmatch bln (strcase rat:ftr)))
(progn
(if rat:lay
(setq val (mapcar '(lambda ( x ) (cons (strcase (cdar x)) (cdr x))) val)
val (AA:massoc (strcase (cdr (assoc 410 (entget ent)))) val)
)
)
(if rat:blk
(setq val (mapcar '(lambda ( x ) (cons (strcase (cdar x)) (cdr x))) val)
val (cdr (assoc bln val))
)
(setq val (car val))
)
(if val
(foreach att (vlax-invoke (vlax-ename->vla-object ent) 'getattributes)
(if
(and
(setq str (assoc (strcase (vla-get-tagstring att)) val))
(progn
(setq val (AA:remove1st str val))
(/= (vla-get-textstring att) (cdr str))
)
)
(progn
(vla-put-textstring att (cdr str))
(setq flg t
ano (1+ ano)
)
)
)
)
)
(if flg (setq bno (1+ bno)))
)
)
)
(if (zerop ano)
(princ "\nAll attributes are up-to-date.")
(princ
(strcat
"\n" (itoa ano) " attribute" (if (= 1 ano) "" "s")
" updated in " (itoa bno) " block" (if (= 1 bno) "" "s") "."
)
)
)
(AA:endundo (AA:acdoc))
)
)
(princ)
)
(defun AA:al-effectivename ( ent / blk rep )
(if (wcmatch (setq blk (cdr (assoc 2 (entget ent)))) "`**")
(if
(and
(setq rep
(cdadr
(assoc -3
(entget
(cdr
(assoc 330
(entget
(tblobjname "block" blk)
)
)
)
'("AcDbBlockRepBTag")
)
)
)
)
(setq rep (handent (cdr (assoc 1005 rep))))
)
(setq blk (cdr (assoc 2 (entget rep))))
)
)
blk
)
(defun AA:readcsv ( csv / des lst sep str )
(if (setq des (open csv "r"))
(progn
(setq sep (cond ((vl-registry-read "HKEY_CURRENT_USER\\Control Panel\\International" "sList")) (",")))
(while (setq str (read-line des))
(setq lst (cons (AA:csv->lst str sep 0) lst))
)
(close des)
)
)
(reverse lst)
)
(defun AA:csv->lst ( str sep pos / s )
(cond
( (not (setq pos (vl-string-search sep str pos)))
(if (wcmatch str "\"*\"")
(list (AA:csv-replacequotes (substr str 2 (- (strlen str) 2))))
(list str)
)
)
( (or (wcmatch (setq s (substr str 1 pos)) "\"*[~\"]")
(and (wcmatch s "~*[~\"]*") (= 1 (logand 1 pos)))
)
(AA:csv->lst str sep (+ pos 2))
)
( (wcmatch s "\"*\"")
(cons
(AA:csv-replacequotes (substr str 2 (- pos 2)))
(AA:csv->lst (substr str (+ pos 2)) sep 0)
)
)
( (cons s (AA:csv->lst (substr str (+ pos 2)) sep 0)))
)
)
(defun AA:csv-replacequotes ( str / pos )
(setq pos 0)
(while (setq pos (vl-string-search "\"\"" str pos))
(setq str (vl-string-subst "\"" "\"\"" str pos)
pos (1+ pos)
)
)
str
)
(defun AA:massoc ( key lst / item )
(if (setq item (assoc key lst))
(cons (cdr item) (AA:massoc key (cdr (member item lst))))
)
)
(defun AA:remove1st ( itm lst / f )
(setq f equal)
(vl-remove-if '(lambda ( a ) (if (f a itm) (setq f (lambda ( a b ) nil)))) lst)
)
(defun AA:startundo ( doc )
(AA:endundo doc)
(vla-startundomark doc)
)
(defun AA:endundo ( doc )
(while (= 8 (logand 8 (getvar 'undoctl)))
(vla-endundomark doc)
)
)
(defun AA:acdoc nil
(eval (list 'defun 'AA:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
(AA:acdoc)
)
(vl-load-com)
(princ
(strcat
"\n:: UpdateTitleblock.lsp | Version 1.9 | \\U+00A9 Lee Mac "
(menucmd "m=$(edtime,0,yyyy)")
" www.lee-mac.com ::"
"\n:: Type \"rat\" to run manually ::\n"
)
)
(princ)
;;(c:rat)
;; ///////opening drawings in a director ///////
;; /////////////////////////////////////////////
(defun C:FCC (/ acapp adoc file_obj fn fold full-names-list full_name_list )
(vl-load-com)
(alert
"\nPlease wait a minute
\nto ending of batch file operation"
)
(setvar "SDI" 0)
(setq fn (getfiled "Select *ANY .DWG FILE* in a desired folder : "
""
"dwg"
4
)
)
(if fn
(progn
(setq fold (vl-filename-directory fn)
full_name_list (vl-directory-files fold "*.dwg" 1)
full_name_list (mapcar (function (lambda (x)
(strcat fold "\\" x)
)
)
full_name_list
)
)
(setq acapp (vlax-get-acad-object)
adoc (vla-get-activedocument acapp)
)
(if full_name_list
(progn
(vla-save adoc);optional
(mapcar
(function
(lambda (dwgnmame)
(progn
(setq file_obj (vla-open (vla-get-documents acapp) dwgnmame))
;;here is batch function:
(rat file_obj)
(vla-saveas file_obj dwgnmame)
(vla-close file_obj)
(vl-cmdf "_delay" 200)
)
)
)
full_name_list
)
)
(princ "\nNo .DWG files in selected directory\n")
)
)
)
(alert "Done")
(princ)
)
