Copy few drawing to separate folder and try this way in background
This is not finished, I need to go asleep, sorry
Code:
(defun C:demo(/ *error *acapp acsp adoc adocs attfound attitems attpairs atts attvalues blkdoc blkpath block data dir
doc elapstime endtime files found nblock newrev num1 num2 oldrev pfs ppt seldata seltype sfar
starttime tags title title_atts title_block t_atts values xlapp xlrange)
(vl-load-com)
(defun *error* (s)
;|(vl-bt)|;
(princ s))
;; Excel part follows
;; File "LDF.xls" must be open then select 926 rows in columns A-C, save file and minimize them, but do not close !
(setq xlapp (vlax-get-or-create-object "Excel.Application"))
(setq xlrange (vlax-get-property
(vlax-get-property xlapp 'selection)
'rows)
)
(setq data (vlax-safearray->list
(vlax-variant-value
(vlax-get-property xlrange 'value2)))
)
(vla-close (vlax-get-property xlapp 'activeworkbook):vlax-false)
(gc)
(vla-quit xlapp)
(vlax-release-object xlapp)
(gc)
;; parse excel data to readable list
(setq values (mapcar '(lambda(x)(mapcar' vlax-variant-value x)) data))
(setq attItems (mapcar '(lambda(x)(list (car x)(cadr x)(if (caddr x)(itoa (fix (caddr x)))"-")(itoa (fix (last x)))))(cdr values)))
;; AutoCAD parts is goes here
;; title block name
(setq title "A$C7E7E5F7C")
;; attributes to change of the title block
;;; (setq title_atts (list
;;; (cons "CONTRACTOR'S_NUMBER" "")
;;; (cons "NUMBER_VALE" "")
;;; (cons "REVISION" "")
;;; (cons "ESCALE" (strcat "1:" (itoa (fix(getvar "dimscale")))))))
;; insertion point of "c_sdk" block
(setq ppt (vlax-3d-point (list 2970.0000 0.0000 0.0000)))
;; attribute values of "c_sdk" block
(setq attvalues (list "B" "DRAWING REALESED FOR MANUFACTURING" "E" "15/11/12" "WG" "BA" "WM" "VSP"))
;; attribute tags of "c_sdk" block
(setq tags
(list "1REVISAO"
"1DESCR"
"1TE"
"1DATA"
"1DES"
"1VERIF"
"1APROV"
"1LIBER"
) ;_ end of list
)
;;selection types
(setq seltype(vlax-safearray-fill
(vlax-make-safearray vlax-vbinteger
(cons 0 1)
)
(list 0 2)
)
)
;;selection values
(setq seldata(vlax-safearray-fill
(vlax-make-safearray vlax-vbvariant
(cons 0 1)
)
(list "insert" title)
)
)
(setq acApp(vlax-get-acad-object))
(setq adoc (vla-get-activedocument acApp))
(and (setq dir "C:/Users/BATCH/");; change directory path to your search path
(setq files (vl-directory-files dir "*.dwg" 1))
)
(setq attItems (vl-remove-if-not '(lambda (x)(member (cadr x) (mapcar 'vl-filename-base files ) ))attItems))
(setq files (mapcar '(lambda (x)(strcat dir x))files))
(setq adocs (vla-get-documents acApp))
(setvar "sdi" 0)
;; change location of "c_sdk" block here:
(setq blkPath "C:/Users/ACCESS/PROCESS.dwg")
(setq startTime (getvar "cdate"))
(foreach dwgPath files
(if
;; get the data record for this document
(setq found (car (vl-remove-if-not '(lambda (x)(eq (cadr x) (vl-filename-base dwgPath))) attItems)))
(progn
(setq num1 (car found)
num2 (cadr found)
oldrev (caddr found)
newrev (last found))
;(setq acsp (vla-get-modelspace dwg))
(setq doc (vla-open adocs dwgPath :vlax-false ""))
;; change attribute list for title block here
(setq title_atts (list
(cons "CONTRACTOR'S_NUMBER" num1)
(cons "NUMBER_VALE" num2)
(cons "REVISION" newrev)
(cons "ESCALE" (strcat "1:" (itoa (fix(vlax-variant-value (vla-getvariable adoc "dimscale"))))))))
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-item (list (vla-get-blocks doc) "c_sdk")))
(progn
(setq blkDoc (vla-open adocs blkPath :vlax-false))
(setq block (vl-catch-all-apply 'vla-item (list (vla-get-blocks blkDoc) "c_sdk")))
(setq sfar
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray vlax-vbobject
(cons 0 0)
)
(list block)
)
)
)
(not (vl-catch-all-error-p
(vl-catch-all-apply
'(lambda ()
(vla-copyobjects
blkDoc ;;source drawing that is contains the block definition
sfar
(vla-get-blocks doc)
)
)
))
)
(vla-close blkDoc)(vlax-release-object blkDoc)))
(if (not(vl-catch-all-error-p (vl-catch-all-apply 'vla-item (list (vla-get-blocks doc) "c_sdk"))))
(progn
(vla-setvariable doc "ctab" "Model")
(setq acsp (vla-get-modelspace doc))
(setq pfs (vla-get-pickfirstselectionset doc))(vl-catch-all-apply 'vla-clear (list pfs))
(vla-zoomextents (vla-get-application doc))
(vla-select pfs acselectionsetall nil nil seltype seldata)
(setq title_block (vl-catch-all-apply 'vla-item (list pfs 0)))
;; change title block attributes
(setq t_atts (vlax-invoke title_block 'getattributes))
(foreach att t_atts
(if (setq attfound (assoc (vla-get-tagstring att )title_atts))
(vla-put-textstring att (cdr attfound))))
(setq nblock(vl-catch-all-apply 'vla-insertblock (list acsp ppt "c_sdk" 5 5 5 0)))
(vl-catch-all-apply 'vla-put-xeffectivescalefactor (list nblock 5))
(vl-catch-all-apply 'vla-put-Yeffectivescalefactor (list nblock 5))
(vl-catch-all-apply 'vla-put-zeffectivescalefactor (list nblock 5))
;; change "c_sdk" block attributes
(setq atts (vlax-invoke nblock 'getattributes))
(setq attpairs (mapcar 'cons tags attvalues))
(foreach att atts
(if (setq attfound (assoc (vla-get-tagstring att)attpairs))
(vla-put-textstring att (cdr attfound))))
(vla-save doc)(vla-close doc)))))
)
(setq endTime (getvar "cdate"))
(setq elapsTime (rtos (- endTime startTime)2 6))
(alert (strcat"Time elapsed:\t" elapsTime))
(princ)
)