Extract properties of blocks present in a drawing

[Bª™ªN1534592500]

Hi

 

Is is possible to extract the properties of the blocks in a particular drawing (i.e. block name, x coordinates, y coordinates and rotation) and prints a comma delimited text file output?

 

Sample text file output will be like the following:

 

TypeK,30.415,15.601,90
TypeI,111.015,15.601,90
TypeA,111.015,28.201,90
TypeG,126.615,28.201,0
TypeK,126.615,48.941,90
TypeK,142.215,48.941,90
TypeK,142.215,99.601,0
TypeK,30.415,99.601,0
TypeK,38.215,99.601,0
TypeI,46.015,99.601,90

Thanks.

[Lee Mac]

Look into the DATAEXTRACTION command.

[BlackBox]

DATAEXTRACTION is more complete, I just happened to code something similar recently, and thought I'd post. Take from this what you will.

 

(defun c:BlockProp  (/ *error* ss path acApp acDoc oShell file coord)
 ;; RenderMan, 2012
 (princ "\rBLOCKPROP ")
 (vl-load-com)

 (defun *error*  (msg)
   (if oShell (vlax-release-object oShell))
   (if file (close file))
   (cond ((not msg))                                                   ; Normal exit
         ((member msg '("Function cancelled" "quit / exit abort")))    ; <esc> or (quit)
         ((princ (strcat "\n** Error: " msg " ** "))))                 ; Fatal error, display it
   (princ))

 (if (and (setq ss (ssget "_x" '((0 . "INSERT"))))
          (setq path
                 (strcat (vl-filename-directory (vl-filename-mktemp))
                         "\\Block Properties.csv"))
          (setq acApp (vlax-get-acad-object))
          (setq acDoc (vla-get-activedocument acApp))
          (setq oShell
                 (vla-getinterfaceobject acApp "Shell.Application")))
   (progn
     (setq file (open path "w"))
     (write-line "BLOCK PROPERTIES" file)
     (write-line "" file)
     (write-line
       (strcat "Drawing:, , " (getvar 'dwgprefix) (getvar 'dwgname))
       file)
     (write-line
       (strcat "Date:, , "
               (menucmd "M=$(edtime,$(getvar,date),YYYY-MO-DD)"))
       file)
     (write-line "" file)
     (write-line "NAME, X, Y, Z, ROTATION" file)
     (vlax-for oBlock
               (setq ss (vla-get-activeselectionset acDoc))

       (write-line
         (strcat
           (vla-get-effectivename oBlock)
           ","
           (rtos
             (car (setq coord (vlax-get oBlock 'insertionpoint))))
           ","
           (rtos (cadr coord))
           ","
           (rtos (caddr coord))
           ","
           (rtos (vla-get-rotation oBlock)))
         file))
     (setq file (close file))
     (vlax-invoke oShell 'open path)
     (*error* nil))
   (*error* "No blocks found")))

[Bª™ªN1534592500]

Thanks guys. DATAEXTRACTION command gives very detailed output and very powerful. RenderMan, that's cool, I never expect that lisp can be able to do that.

[BlackBox]

Thanks guys. DATAEXTRACTION command gives very detailed output and very powerful.

 

As I do not have the need for this command, I often forget about it (hence the code).

 

RenderMan, that's cool, I never expect that lisp can be able to do that.

 

That is kind of you to say; Lee and many others helped me come to learn much of what I now know.

[Bª™ªN1534592500]

RenderMan, I encountered an error and not opening the csv file under the temporary file. I just modified the path name and it works perfectly. Here's the code that works for me:

 

(defun c:BlockProp  (/ *error* ss path acApp acDoc oShell file coord)
 ;; RenderMan, 2012
 (princ "\rBLOCKPROP ")
 (vl-load-com)

 (defun *error*  (msg)
   (if oShell (vlax-release-object oShell))
   (if file (close file))
   (cond ((not msg))                                                   ; Normal exit
         ((member msg '("Function cancelled" "quit / exit abort")))    ; <esc> or (quit)
         ((princ (strcat "\n** Error: " msg " ** "))))                 ; Fatal error, display it
   (princ))

 (if (and (setq ss (ssget "_x" '((0 . "INSERT"))))
          (setq path C:\\Users\\ZAGM01373\\Documents\\Batman.csv") ;Please change this to your preferred file path and name
          (setq acApp (vlax-get-acad-object))
          (setq acDoc (vla-get-activedocument acApp))
          (setq oShell
                 (vla-getinterfaceobject acApp "Shell.Application")))
   (progn
     (setq file (open path "w"))
     (write-line "BLOCK PROPERTIES" file)
     (write-line "" file)
     (write-line
       (strcat "Drawing:, , " (getvar 'dwgprefix) (getvar 'dwgname))
       file)
     (write-line
       (strcat "Date:, , "
               (menucmd "M=$(edtime,$(getvar,date),YYYY-MO-DD)"))
       file)
     (write-line "" file)
     (write-line "NAME, X, Y, Z, ROTATION" file)
     (vlax-for oBlock
               (setq ss (vla-get-activeselectionset acDoc))

       (write-line
         (strcat
           (vla-get-effectivename oBlock)
           ","
           (rtos
             (car (setq coord (vlax-get oBlock 'insertionpoint))))
           ","
           (rtos (cadr coord))
           ","
           (rtos (caddr coord))
           ","
           (rtos (vla-get-rotation oBlock)))
         file))
     (setq file (close file))

     (vlax-invoke oShell 'open path)
     (*error* nil))
   (*error* "No blocks found")))

[BlackBox]

That's very strange, as it (the code I posted) not only works well on my end, but according to the developer documentation uses your environment's temporary settings.

 

More on vl-Filename-Mktemp function.

 

Rather then hard-coding the location for each user, perhaps identify a common directory that will work for your setup, and use (getvar 'loginname) to remove the need for each user to modify. Just a thought.

[Bª™ªN1534592500]

I tried it again and it's working now. I don't know why yesterday the csv file is not opening after the command. Probably the problem is just I didn't wait long enough for the lisp to open it, because I tried it several times and I was forced to locate the file manually.

 

Thanks a lot, I will use your original code.

[asos2000]

RenderMan, I encountered an error and not opening the csv file under the temporary file. I just modified the path name and it works perfectly. Here's the code that works for me:

 

(defun c:BlockProp
...

The wrong in your code is

(defun c:BlockProp
...
          (setq path [color="red"]C[/color]:\\Users\\ZAGM01373\\Documents\\Batman.csv")

 

Should be

(defun c:BlockProp
...
          (setq path[color="red"] "C[/color]:\\Users\\ZAGM01373\\Documents\\Batman.csv")

[goØn]

Good topic Bª™ªN

 

That's also very generous for you to share that bit of code RenderMan, so thank you,

[BlackBox]

Batman - I'm glad you got everything working.

 

Go0n - Always happy to help.