BBOX:ExportLayout

abra-CAD-abra · 发表于 2022-7-5 18:20:55

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:

[code](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 [Active/Browse]: ")))(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) ;

ymg3 · 发表于 2022-7-5 18:33:03

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.

ymg3 · 发表于 2022-7-5 18:40:16

Here I've edited the section that are most likely to be the culprit.

I did not run it, so test it.

copy

;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 [Active/Browse]: ")))     (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

abra-CAD-abra · 发表于 2022-7-5 18:45:32

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,

abra-CAD-abra · 发表于 2022-7-5 18:57:53

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.

copy

;;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))                                  "[url="file://\\Export"]\\Export[/url] 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 [Active/Browse]: ")))     (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,

ymg3 · 发表于 2022-7-5 19:04:18

Probably because the drawing does not get become active as you are interfacig
via an object .

So you need to modify the following:

copy

(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.

copy

(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:

copy

(defun c:exportlayout (/ opt dwgs)    (initget "Active Browse")  (if (not (setq opt (getkword "\nWhat drawing would you like to process [Active/Browse]: ")))     (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))

Lee Mac · 发表于 2022-7-5 19:11:38

Here's another way:

copy

(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?

ymg3 · 发表于 2022-7-5 19:20:14

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.

copy

(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

abra-CAD-abra · 发表于 2022-7-5 19:25:34

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!

[编程交流] BBOX:ExportLayout

发表回复

精选推荐