;Modified by Igal Averbuh 2015.. Based on
;http://www.cadtutor.net/forum/archive/index.php/t-78786.html? ;
(defun bbox:exportlayout (dwgs / *error* bbox:getdate bbox:gettime bbox:writedata
acapp odocuments oshell path filepath dbxdoc file
opendoc olayouts layoutname)
(vl-load-com)

(defun *error* (msg)
(if file (close file))
(if oshell (vlax-release-object oshell))
(if dbxdoc (vlax-release-object dbxdoc))
(cond ((not msg))
((member msg '("Function cancelled" "quit / exit abort")))
((princ (strcat "\n** Error: " msg " ** ")))
)
(princ)
)

(defun bbox:getdate (date)
(setq date (mapcar '(lambda (x) (itoa x)) date))
(strcat (nth 0 date) "-" (nth 1 date) "-" (nth 3 date))
)

(defun bbox:gettime (date / hr mn)
(setq hr (nth 4 date))
(setq mn (itoa (nth 5 date)))
(if (= 1 (strlen mn))
(setq mn (strcat "0" mn))
)
(cond ((> 12 hr) (strcat (itoa hr) ":" mn " AM"))
((strcat (itoa (- hr 12)) ":" mn " PM"))
)
)

(defun bbox:writedata (dwg layoutname file / filepath date)
(write-line
(vl-string-right-trim
","
(apply
'strcat
(mapcar
'(lambda (x) (strcat x ","))
(list (setq filepath (strcat dwg))
(if (setq date (vl-file-systime filepath))
(bbox:getdate date)
""
)
(if date
(bbox:gettime date)
""
)
layoutname
)
)
)
)
file
)
)

(if (and (setq acapp (vlax-get-acad-object))
(setq odocuments (vla-get-documents acapp))
(setq oshell (vla-getinterfaceobject acapp "Shell.Application"))
(setq path (car dwgs))
(setq filepath (strcat (vl-filename-directory (vl-filename-mktemp))
"\\Export Layout Report_"
(getvar 'DWGNAME)"_"(menucmd "M=$(edtime,$(getvar,date),DD-MO-YYYY)")
".csv"
)
)
(princ "\nWorking, please wait...")
(princ)
(setq dbxdoc (vla-getinterfaceobject acapp (strcat "ObjectDBX.AxDbDocument." (substr (getvar 'acadver) 1 2))))
)
(progn
(setq file (open filepath "w"))
(write-line "Directory Searched:" file)
(write-line path file)
(write-line "" file)
(write-line "Drawing Name: , ******** , ******** ,Layout Name:" file)
(foreach dwg dwgs ; edited here (cdr dwgs)
(if (not (vl-catch-all-error-p
(setq opendoc (vl-catch-all-apply
'vla-item
(list odocuments dwg)
)
)
)
)
(setq olayouts (vla-get-layouts opendoc))
(progn
(vl-catch-all-apply
'vla-open
(list dbxdoc dwg) ;edited here (strcat path dwg)
)
(setq olayouts (vla-get-layouts dbxdoc))
)
)
(vlax-for olayout olayouts
(if (/= "Model" (setq layoutname (vla-get-name olayout)))
(bbox:writedata (getvar 'DWGNAME) layoutname file) ; Edited (bbox:writedata path dwg layoutname file
)
)
)
(princ "Done.")
(princ)
;(setq file (close file)) ;Abra-CAD-Abra
(vlax-invoke oshell 'open filepath)
(*error* nil)
)
(cond
(filepath (*error* "Unable to create \"ObjectDBX.AxDbDocument\" Object"))
(acapp (*error* "Unable to create \"Shell.Application\" Object"))
)
)
)

(defun c:el (/ opt dwgs)

(defun str2lst (str sep / len lst)
(setq len (strlen sep))
(while (setq pos (vl-string-search sep str))
(setq lst (cons (substr str 1 pos) lst)
str (substr str (+ len pos 1))
)
)
(reverse (cons (substr str 1 pos) lst))
)

(initget "Enter")
(if (not (setq opt (getkword "\nPress Enter if you would like to process Active Drawing: ")))
(setq opt "Enter")
)
(cond
((= "Enter" opt) (if (= 1 (getvar 'dwgtitled))
(bbox:exportlayout (list (getvar 'dwgprefix) (getvar 'dwgname)))
(prompt "\n** Drawing not saved ** ")
))

)

(princ)
)
(c:el)

Advertisements