BBOX:ExportLayout
All,The code below by BlackBox exports layout names from drawings; either the active drawing or a selection of drawings. The layout names are exported to an Excel file.
It currently uses the function 'dos_getfilem', from the doslib library, available at:
http://www.en.na.mcneel.com/doslib.htm
Since I am unable to install the above doslib file(s) on my computer, I have modified the code to use Lee Mac's 'getfilesdialog'. I have changed the code from line 174 to 189 to use Lee Mac's function, however, it does not function as expected with the "Browse" option. That is, it does not list all of the layout names in each of the drawings selected?
I have posted the modified code below:
(vl-load-com);http://www.cadtutor.net/forum/archive/index.php/t-78786.html?(defun BBOX:ExportLayout (dwgs / *error* BBOX:GetDate BBOX:GetTimeBBOX:WriteData acApp oDocuments oShell pathfilePath dbxDoc file openDoc oLayouts layoutName)(defun *error* (msg)(if file(close file))(if oShell(vlax-release-object oShell))(if dbxDoc(vlax-release-object dbxDoc))(cond ((not msg)) ; Normal exit((member msg '("Function cancelled" "quit / exit abort"))) ;or (quit)((princ (strcat "\n** Error: " msg " ** "))) ; Fatal error, display it)(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 (path dwg layoutName file / filePath date)(write-line(vl-string-right-trim","(apply'strcat(mapcar'(lambda (x) (strcat x ","))(list (setq filePath (strcat path dwg))(if (setq date (vl-file-systime filePath))(BBOX:GetDate date)"{ Read-Only }")(if date(BBOX:GetTime date)"{ Read-Only }")layoutName))))file))(if (and (setq acApp (vlax-get-acad-object))(setq oDocuments (vla-get-documents acApp))(setq oShell (vla-getinterfaceobjectacApp"Shell.Application"))(setq path (car dwgs))(setq filePath(strcat(vl-filename-directory(vl-filename-mktemp))"\\Export Layout Report_"(menucmd"M=$(edtime,$(getvar,date),YYYY-MO-DD)")".csv"))(princ "\nWorking, please wait...")(princ)(setq dbxDoc (vla-getinterfaceobjectacApp(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:,Date:,Time:,Layout Name:" 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 (strcat path dwg)))(setq oLayouts (vla-get-layouts dbxDoc))))(vlax-for oLayout oLayouts(if (/= "Model" (setq layoutName (vla-get-name oLayout)))(BBOX:WriteData path dwg layoutName file))))(princ "Done.")(princ)(setq file (close file))(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:ExportLayout (/ opt dwgs)(initget "Active Browse")(if(not(setq opt(getkword"\nWhat drawing would you like to process : ")))(setq opt "Active"))(cond ((= "Active" opt)(if (= 1 (getvar 'dwgtitled))(BBOX:ExportLayout(list (getvar 'dwgprefix) (getvar 'dwgname)))(prompt "\n** Drawing not saved ** ")))((= "Browse" opt)(if (setq dwgs;Replaced;(dos_getfilem ;From Here http://www.en.na.mcneel.com/doslib.htm;"Select Drawings";(getvar 'dwgprefix) ; The return from the dos_lib fuction and Lee's one are different.
Don't know if you accounted for it.
Edit: A quick inspection of the code on variable path confirms
that it is most likely the problem.
Here I've edited the section that are most likely to be the culprit.
I did not run it, so test it.
;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 (path dwg layoutname file / filepath date) (write-line (vl-string-right-trim "," (apply 'strcat (mapcar '(lambda (x) (strcat x ",")) (list (setq filepath (strcat path dwg)) (if (setq date (vl-file-systime filepath)) (bbox:getdate date) "{ Read-Only }" ) (if date (bbox:gettime date) "{ Read-Only }" ) 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_" (menucmd "M=$(edtime,$(getvar,date),YYYY-MO-DD)") ".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:,Date:,Time:,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 'DWGPREFIX)(getvar 'DWGNAME) layoutname file); Edited (bbox:writedata path dwg layoutname file) ) ) ) (princ "Done.") (princ) (setq file (close file)) (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:exportlayout (/ opt dwgs) (initget "Active Browse")(if (not (setq opt (getkword "\nWhat drawing would you like to process : "))) (setq opt "Active"))(cond ((= "Active" opt) (if (= 1 (getvar 'dwgtitled)) (bbox:exportlayout (list (getvar 'dwgprefix) (getvar 'dwgname))) (prompt "\n** Drawing not saved ** ") )) ((= "Browse" opt) (if (setq dwgs (lm:getfiles "Select Drawings" "getvar 'dwgprefix" "dwg")) (bbox:exportlayout dwgs) )))(princ))
abraCADabra.LSP Thanks ymg3,
I was unable to test the original code because I am not allowed to install the doslib functions from the website.
Thank you very much indeed for taking the time to look at the code - Much appreciated.
I will take a look at your edits now.
Cheers, Hi ymg3,
I tested the code and it presented stringp and streamp errors on lines 64 and 107 respectively (*I think*).
I have amended the code on these lines and (I think) it now works as expected.
;;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 (path dwg layoutname file / filepath date) (write-line (vl-string-right-trim "," (apply 'strcat (mapcar '(lambda (x) (strcat x ",")) (list (setq filepath (strcat path dwg)) (if (setq date (vl-file-systime filepath)) (bbox:getdate date) "{ Read-Only }" ) (if date (bbox:gettime date) "{ Read-Only }" ) 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)) ;Keep this line - Abra-CAD-Abra (setq filepath (strcat (vl-filename-directory (vl-filename-mktemp)) "\\Export Layout Report_" (menucmd "M=$(edtime,$(getvar,date),YYYY-MO-DD)") ".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:,Date:,Time:,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 'DWGPREFIX)(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:exportlayoutnames (/ opt dwgs)(initget "Active Browse")(if (not (setq opt (getkword "\nWhat drawing would you like to process : "))) (setq opt "Active"))(cond ((= "Active" opt) (if (= 1 (getvar 'dwgtitled)) (bbox:exportlayout (list (getvar 'dwgprefix) (getvar 'dwgname))) (prompt "\n** Drawing not saved ** ") )) ((= "Browse" opt) (if (setq dwgs (lm:getfiles "Select Drawings" "getvar 'dwgprefix" "dwg")) (bbox:exportlayout dwgs) )))(princ))
The only issue, as it stands; it does not give the path and dwgname of each drawing processed. I am trying to fix this but with no joy...
Cheers, Probably because the drawing does not get become active as you are interfacig
via an object .
So you need to modify the following:
(bbox:writedata (getvar 'DWGPREFIX)(getvar 'DWGNAME) layoutname file)
You need to split dwg into a path and name, so you could use this
little fuction by Gile Chanteau.
(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)))
Instead of modifying the original code, we can change the return of lee's function to mimick the dos_lib's one:
(defun c:exportlayout (/ opt dwgs) (initget "Active Browse")(if (not (setq opt (getkword "\nWhat drawing would you like to process : "))) (setq opt "Active"))(cond ((= "Active" opt) (if (= 1 (getvar 'dwgtitled)) (bbox:exportlayout (list (getvar 'dwgprefix) (getvar 'dwgname))) (prompt "\n** Drawing not saved ** ") )) ((= "Browse" opt) (if (setq tmpl (lm:getfiles "Select Drawings" "getvar 'dwgprefix" "dwg")) (setq dwgs(mapcar '(lambda (a) (last(str2lst a "\\"))) tmpl) path(substr (car tmpl)1 (vl-string-search (car dwgs)(car tmpl))) dwgs(cons path dwgs) ** (bbox:exportlayout dwgs) ) )))(princ)) Here's another way:
(if (setq dwgs (LM:getfiles "Select Drawings" (getvar 'dwgprefix) "dwg")) (bbox:exportlayout (cons (vl-filename-directory (car dwgs)) (mapcar '(lambda ( x ) (strcat (vl-filename-base x) ".dwg")) dwgs))))But what if the user selects drawings from multiple directories? Lee,
As it is the routine can handle only one directory at a time.
By the way you are missig the closing backslash on the path.
(if (setq dwgs (LM:getfiles "Select Drawings" (getvar 'dwgprefix) "dwg"))(bbox:exportlayout (cons (strcat (vl-filename-directory (car dwgs)) "\\") (mapcar '(lambda ( x ) (strcat (vl-filename-base x) ".dwg")) dwgs))))
ymg Thank you ymg3 and thank you, Lee
I will study your suggestions once I am back in the office.
Again, thanks for taking the time to look at this.
I should also say thanks to BlackBox for the original thread - cheers!
页:
[1]