;Modified by Igal Averbuh 2015 and Roy_043.. Based on
;http://www.cadtutor.net/forum/archive/index.php/t-78786.html?
;http://www.theswamp.org/index.php?topic=50527.new;topicseen#new
; get paper size on current tab
(defun papersize (olayout / elst scale)

(setq elst (entget (vlax-vla-object->ename olayout)))

(setq scale (if (= 0 (cdr (assoc 72 elst))) 25.4 1.0))

(strcat

(rtos (/ (cdr (assoc 44 elst)) scale) 2 2)

" x "

(rtos (/ (cdr (assoc 45 elst)) scale) 2 2)

)

)

(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 "Current File:" file)
(write-line (getvar 'DWGNAME) file)
(write-line "" file)
(write-line "Layout Name:, ******** , ******** ,Paper Size:" file)
(foreach dwg (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 layoutname (papersize olayout) 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:pel (/ 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:pel)

Advertisements