Extract block name from DWG and save to TXT

[L00K]

Hi,

i have over 50 000 dwg's that will be migrated to Autodesk Vault. In order to be able to extract attributes from these dwg's and into Vault's UPD's i need to map properties.

Before i can do it i need to list up all title blocks that have been used with these 50 000 drawings (there have been used approx 60 different templates with own title block names).

What i try to do now is to create AutoLisp that will open every single drawing, read all blocks,  save results into a TXT file, close current file and open the next one. 

I have managed to get a code doing all of this except closing file and opening a new one. Autocad crashes after collected data is saved into a TXT file. 

I would appreciate help i finding error that causes Autocad crash. 

I use Autocad 2023.

Thanks!

Here the code:

(defun c:ExportBlockNamesToTextFile ()
  (vl-load-com)

  ;; Prompt for folder path
  (princ "\nEnter the folder path containing DWG files (e.g., C:\\MyDWGs): ")
  (setq folder (getstring))

  ;; Check if folder exists
  (if (and folder (vl-file-directory-p folder))
    (progn
      ;; Get DWG files in the folder
      (setq dwg-files (vl-directory-files folder "*.dwg" 1))
      (if dwg-files
        (progn
          ;; Create output and error log files
          (setq output-file (strcat folder "\\BlockNamesReport.txt"))
          (setq error-log (strcat folder "\\ErrorLog.txt"))
          (setq file-handle (open output-file "w"))
          (setq log-handle (open error-log "w"))

          ;; Process each DWG file
          (foreach dwg dwg-files
            (setq full-path (strcat folder "\\" dwg))
            (princ (strcat "\nProcessing: " full-path))
            (setq doc nil) ;; Initialize document variable

            ;; Use error-handling wrapper
            (setq result
                  (vl-catch-all-apply
                    (function
                      (lambda ()
                        ;; Open and activate the document
                        (setq doc (vla-open (vla-get-documents (vlax-get-acad-object)) full-path))
                        (vla-activate doc)

                        ;; Get Model Space and block references
                        (setq ms (vla-get-modelspace doc))
                        (setq blk-names "")
                        (vlax-for obj ms
                          (if (= (vla-get-objectname obj) "AcDbBlockReference")
                            (setq blk-names (strcat blk-names (vla-get-effectivename obj) "\n"))
                          )
                        )

                        ;; Write results to the output file
                        (if (> (strlen blk-names) 0)
                          (progn
                            (write-line (strcat "DWG File: " dwg) file-handle)
                            (write-line "Block Names:" file-handle)
                            (write-line blk-names file-handle)
                            (write-line "----------------------------" file-handle)
                          )
                          (progn
                            (write-line (strcat "DWG File: " dwg) file-handle)
                            (write-line "No blocks found." file-handle)
                            (write-line "----------------------------" file-handle)
                          )
                        )

                        ;; Close and release resources
                        (if doc
                          (progn
                            (vla-save doc)
                            (vla-close doc)
                            (vlax-release-object doc)
                            (setq doc nil)
                          )
                        )
                      )
                    )
                  )
            )

            ;; Handle errors
            (if (vl-catch-all-error-p result)
              (progn
                (princ (strcat "\nError processing: " full-path " - " (vl-catch-all-error-message result)))
                (write-line (strcat "Error processing: " full-path " - " (vl-catch-all-error-message result)) log-handle)
                ;; Attempt to close the document if open
                (if (and doc (not (vlax-erased-p doc)))
                  (progn
                    (vla-close doc)
                    (vlax-release-object doc)
                  )
                )
              )
            )

            ;; Force garbage collection
            (gc)
          )

          ;; Close the output and error log files
          (close file-handle)
          (close log-handle)
          (princ (strcat "\nBlock names have been exported to: " output-file))
          (princ (strcat "\nErrors logged to: " error-log))
        )
        (princ "\nNo DWG files found in the specified folder.")
      )
    )
    (princ "\nInvalid folder path.")
  )
  (princ)
)

[Moshe-A]

@L00K hi,

AutoLISP is available only inside open document.

to run autolisp command on multiple drawings you have to use script file (.scr)

to quickly create script file, you can use lee mac >> script writer << 

you will have to modify your lisp by removing the part for selecting the drawing file.

Moshe

[L00K]

Thanks i have just realised that if i run "close" command on the another file so i can close inactiv drawing without Autocad crash. The question now is how to automatise the whole process. Scan folder and subfolder for dwg->open dwg->read name of the titleblocks and save them to the file-> open next file from the list->close previous file->read name of the titleblock..........

I have never worked with AutoLisp and scripts before so i would need to reach for help 🙂

[cadffm]

Hi,

I am reading on a 6" mobile, so I can't read all the code well, but in a hurry:

you set the files active,

1. this seams to be the problem and

2. it shouldn't be needed (and slow down the process)

Test it without this line

(vla-activate doc)

[Moshe-A]

@L00K ,

i modified your lisp to fit for running in script.

now whats left is to explore a bit >> script write <<  by Lee Mac and you done 😀

remember to load the lisp at each dwg you open and call the function and pass the folder name as an argument.

(ExportBlockNamesToTextFile "folder-name")

enjoy

Moshe

(vl-load-com)

(defun ExportBlockNamesToTextFile  (folder / output-file file-handle doc ms obj name blk-names)
 ; (setq folder "C:\\Users\\user\\Documents")
 (setq output-file (strcat folder "\\BlockNamesReport.txt"))

 (cond
  ((not (setq file-handle (open output-file "a"))) ; open file for append
    (vlr-beep-reaction)
    (prompt (strcat "\nfail to open " output-file))
  ); case
  ( t
    (setq doc (vla-get-activedocument (vlax-get-acad-object)))
    ;; Get Model Space and block references
    (setq ms (vla-get-modelspace doc)) 
  
    (vlax-for obj ms
     (if (= (vla-get-objectname obj) "AcDbBlockReference")
      (progn
       (setq name (strcase (vla-get-effectivename obj)))
       (if (null (member name blk-names))
        (setq blk-names (cons name blk-names))
       ); if
      ); progn
     ); if
    ); vlax
  
    ;; Write results to the output file
    (write-line (strcat "DWG File: " (getvar "dwgname")) file-handle)
    (write-line "Block Names:" file-handle)
  
    (if (> (vl-list-length blk-names) 0)
     (foreach name (reverse blk-names)
      (write-line name file-handle)
     )
     ; else
     (write-line "No blocks found." file-handle)
    ); if

    (write-line "----------------------------" file-handle)
    (setq file-handle (close file-handle))

    (vlax-release-object ms)
    (vlax-release-object doc)
   ); case
 ); cond
  
 (princ)
); ExportBlockNamesToTextFile

[Sea-Haven]

This was the most obvious problem and @Moshe-A caught it. For future reference.

(setq file-handle (open output-file "A") 
; appends any write-line to one file does not overwrite the file

(setq file-handle (open output-file "W") 
; writes a line but will overwrite file name each time called up.

(setq file-handle (open output-file "R")
; reads a file one line at a time 

Just a comment do you want all block names used or not ? Or only block names that have actually been used. Using purge will help removing unused blocks. If you have Civ3D dwg's maybe look at "Purgstylesandsettings" before purge.

[L00K]

Thanks a lot!  I appreciate your help.

As i said i am completly new to autolisp and scripts so for sure i will do something wrong in the next steps..

What i did so far:

1. I have loaded the lisp file (with corrected by you code) into the ACADDOC.lsp

2. I run the Script Writer and created the scr file with just "_.open *file* _.saveas *file* _.close*file*" line, and run it. 

3. This is how looks the scr file:

_.open "D:\temp\\0000A01F.DWG" _.saveas  "D:\temp\\0000A01F.DWG" _.close"D:\temp\\0000A01F.DWG"
_.open "D:\temp\\2000-901.DWG" _.saveas  "D:\temp\\2000-901.DWG" _.close"D:\temp\\2000-901.DWG"
_.open "D:\temp\\A00-000-00A\A00-000-00A-AUT\0000A01F.DWG" _.saveas  "D:\temp\\A00-000-00A\A00-000-00A-AUT\0000A01F.DWG" _.close"D:\temp\\A00-000-00A\A00-000-00A-AUT\0000A01F.DWG"
_.open "D:\temp\\A00-000-00A\A00-000-00A-DRV\00000A-001F.DWG" _.saveas  "D:\temp\\A00-000-00A\A00-000-00A-DRV\00000A-001F.DWG" _.close"D:\temp\\A00-000-00A\A00-000-00A-DRV\00000A-001F.DWG"
_.open "D:\temp\\A00-000-00A\A00-000-00A-DRV\00000A-002F.DWG" _.saveas  "D:\temp\\A00-000-00A\A00-000-00A-DRV\00000A-002F.DWG" _.close"D:\temp\\A00-000-00A\A00-000-00A-DRV\00000A-002F.DWG"
_.open "D:\temp\\A00-000-00A\A00-000-00A-MEK\00000A-001D.dwg" _.saveas  "D:\temp\\A00-000-00A\A00-000-00A-MEK\00000A-001D.dwg" _.close"D:\temp\\A00-000-00A\A00-000-00A-MEK\00000A-001D.dwg"
_.open "D:\temp\\A00-000-00A\A00-000-00A-MEK\0000A01F.DWG" _.saveas  "D:\temp\\A00-000-00A\A00-000-00A-MEK\0000A01F.DWG" _.close"D:\temp\\A00-000-00A\A00-000-00A-MEK\0000A01F.DWG"
_.open "D:\temp\\A00-000-00A\A00-000-00A-MEK\0000A02F.DWG" _.saveas  "D:\temp\\A00-000-00A\A00-000-00A-MEK\0000A02F.DWG" _.close"D:\temp\\A00-000-00A\A00-000-00A-MEK\0000A02F.DWG"
_.open "D:\temp\\A00-000-00A\A00-000-00A-MEK\0000A03F.DWG" _.saveas  "D:\temp\\A00-000-00A\A00-000-00A-MEK\0000A03F.DWG" _.close"D:\temp\\A00-000-00A\A00-000-00A-MEK\0000A03F.DWG"
_.open "D:\temp\\A00-000-00A\A00-000-00A-MEK\0000A04F.DWG" _.saveas  "D:\temp\\A00-000-00A\A00-000-00A-MEK\0000A04F.DWG" _.close"D:\temp\\A00-000-00A\A00-000-00A-MEK\0000A04F.DWG"

4.I did a test just only with this script content (to see if autocad will open, save and close dwgs). When i run this scr inside the autocad i get the following error: "Invalid file name", and in the command line pops up path to the acad.dwt file. If i press ENTER new empty drawing is opened, if i press ESC nothing happens (i guess the script is canceled).

5, How to launch the lsp ExportBlockNamesToTextFile from the script line? something needs to trigger autolisp. 

Sorry for so nooby questions. 🙂

[Moshe-A · Accepted solution]

@L00K hi,

I am sorry but do not take this as criticism, as you see i do put a lot of effort to help you. i was expecting you to enter >> AutoCAD documentation << to learn about scripts, to run  scripts, to open AutoCAD by scripts and after you will have some knowledge (and it is very easy self learning ) you will understand better Lee's Mac Script Writer and then you can complete this - ok?!

you can wrap the my lisp function in lsp file and load it from APPLOAD \Startup Suit\contents or from acad.lsp or acaddoc.lsp any of those is ok.

to call the lisp you add a script line as :

(ExportBlockNamesToTextFile "folder-name")

where "folder-name" is the folder where to open and save BlocknamesReport.txt file

as you can see, lisp expressions can be run from script file.

i notice your lisp export all the blocks only in model space, what about layouts?

it export all blocks that are already insert in drawing, a drawing can have other blocks that are not at the moment inserted - do you want them also?

your lisp write out all inserted blocks and if the a block has duplicate references it writes out each of them.

my lisp filter those duplicate references and record only one from each - is this what you want?

Moshe

[L00K]

I'm sorry i did not mean to be a leasy  dust. I am just new to this. I do appreciate your effort.

Since i did not manage to get it to work so in tried another approche.

I created new lsp reading all blocks inside drawing and  writing it down to the file.

I created a script opening files,  call the lsp and closing it. 

I have created ACAD.lsp and put it in the support folder in order to load my lsp automatically.

Additionally i call my lsp in the scr.

Lsp works if i run it on a single drawing, but if i call it from the script , i ger error in autocad.: error: no function definition.

Command: (c:SaveTitleBlocksToTxtFile) ; error: no function definition: C:SAVETITLEBLOCKSTOTXTFILE

Code for the lsp:

(defun c:SaveBlockNamesToTxtFile (/ blkname blklist filehandle filepath dwgname error-result)
  ;; Define the path of the text file where names will be saved.
  ;; You can change the file path as needed.

  (setq filepath "d:/Temp/BlockNames.txt")

  ;; Get the name of the current DWG file.
  (setq dwgname (getvar "DWGNAME"))

  ;; Function to get all block references from model space.
  (defun get-block-names (/ ms blk blocknames)
    (setq blocknames '())
    ;; Get the model space object.
    (setq ms (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))))
    ;; Iterate through all objects in model space.
    (vlax-for blk ms
      (if (eq (vla-get-ObjectName blk) "AcDbBlockReference")
        (setq blocknames (cons (vla-get-EffectiveName blk) blocknames))))
    blocknames)

  ;; Try to open the file for appending and handle errors if the file is locked.
  (setq error-result (vl-catch-all-apply 'open (list filepath "a")))
  (if (vl-catch-all-error-p error-result)
    (progn
      (alert "Error: The file is locked or cannot be accessed.")
      (princ "The script has been stopped because the file is locked or inaccessible.\n"))
    (progn
      ;; File successfully opened, proceed with writing data.
      (setq filehandle error-result)

      ;; Get the block names in the current DWG.
      (setq blklist (get-block-names))

      ;; Append the DWG name and block names or indicate no blocks found.
      (write-line (strcat "File: " dwgname) filehandle)
      (if blklist
        (progn
          (foreach blkname blklist
            (write-line (strcat "  Block: " blkname) filehandle))
          (princ (strcat "Block names saved to " filepath "\n")))
        (progn
          (write-line "  No blocks found in this file." filehandle)
          (princ "No blocks found in the current drawing.\n")))

      ;; Add a separator for clarity.
      (write-line "-----------------------------------" filehandle)

      ;; Close the file.
      (close filehandle)))
  ;; End the program.
  (princ))
	(princ "\nLSP file loaded successfully")

code for the scr

SDI 1
_.open "D:\temp\A00-000-00A\A00-000-00A-MEK\00000A-001D.dwg" (SaveTitleBlocksToTxtFile) _.qsave _.close
_.open "D:\temp\A00-000-00A\A00-000-00A-MEK\0000A01F.DWG" (SaveTitleBlocksToTxtFile) _.qsave _.close
_.open "D:\temp\A00-000-00A\A00-000-00A-MEK\0000A02F.DWG" (SaveTitleBlocksToTxtFile) _.qsave _.close
_.open "D:\temp\A00-000-00A\A00-000-00A-MEK\0000A03F.DWG" (SaveTitleBlocksToTxtFile) _.qsave _.close
_.open "D:\temp\A00-000-00A\A00-000-00A-MEK\0000A04F.DWG" (SaveTitleBlocksToTxtFile) _.qsave _.close
SDI 0

When it comes to the Layout. Most of the drawings are old and have block only on the Model Space. I can always modify the lsp to check the layout  as well, but at this point i do not see this neccessary.

I used your scripts as well. I struggel to properly define "folder-name" under (ExportBlockNamesToTextFile "folder-name").

I continously get error det. I guess i use wrong syntax or format. d:\temp does not work.

Once again thanks for your help!

[L00K]

Got it to work!

Many many Thanks!!!!

[Moshe-A]

@L00K ,

happy to see you finally made it to work 🙏🙏