Data Extraction Existing Excel Sheet

[sanetmunde]

Hello,

I have an AutoCAD Drawing with different Blocks. These blocks have some of the attributes names in common (Height, Length & Width).

Can I extract the attribute data from selected area in drawing to an existing excel sheet with standard template such that the block name comes under column named "Block Name", Value of Height Attribute comes under column "Height" and so on?

Here are the list of things I wanted to do in attached drg

1. Extract data from some blocks (Block Names are: SA GRILLE, SA Slot Diffuser, SA Sq Diffuser, Shoe Piece, Straight Duct, Transition, Elbow) from selected area on drg.

2. Extract the values of Attributes named WIDTH, HEIGHT, WIDTH2, HEIGHT1 & LENGTH

3. The Data should be extracted to an existing excel sheet as attached.

4. The data extracted should come under respective column label.

Is this feasible using VBA?

Here are some links which are helpful but I couldn't get desired results using those.

http://www.lee-mac.com/macatt.html

http://www.cadtutor.net/forum/showthread.php?64960-Browse-for-an-existing-excel-file

 

Dynamic Blocks Data.xlsx

Dynamic Blocks.dwg

[Grrr]

Not exactly what you wanted - I just decided to practice:

 

; http://www.cadtutor.net/forum/showthread.php?102022-Data-Extraction-Existing-Excel-Sheet
; Display Block Data Example
; written by Grrr
(defun C:test ( / Blocks sBlocks Attributes stringp groupbykey MapSS L txt des )
 
 (and ; List Of BlockNames to search [OPTIONAL]
   (setq Blocks '("SA GRILLE" "SA Slot Diffuser" "SA Sq Diffuser" "Shoe Piece" "Straight Duct" "Transition" "Elbow"))
   (setq sBlocks (mapcar 'strcase Blocks))
 ); and
 (setq Attributes (mapcar 'strcase '("WIDTH" "HEIGHT" "WIDTH2" "HEIGHT1" "LENGTH"))) ; List Of Attribute Tags to search [OPTIONAL]
 
 (setq stringp (lambda (x) (eq 'STR (type x))))
 
 ; https://www.theswamp.org/index.php?topic=53515.0
 ; Lee Mac
 (defun groupbykey ( lst / rtn tmp )
   (foreach itm (reverse lst)
     (if (setq tmp (assoc (car itm) rtn))
       (setq rtn (subst (append itm (cdr tmp)) tmp rtn))
       (setq rtn (cons itm rtn))
     )
   )
 )
 
 (defun MapSS ( f SS / rec r ) 
   (defun rec ( f SS / x ) (if (setq x (ssname SS 0)) (cons (f x) (progn (ssdel x SS) (rec f SS)))))
   (and (eq 'PICKSET (type SS)) (member (type (setq f (eval f))) '(SUBR USUBR)) (setq r (rec f SS)) )
   r
 ); defun MapSS
 
 (setq L 
   (groupbykey
     (apply 'append
       (MapSS 
         (lambda ( e / o nm )
           (setq nm (vla-get-EffectiveName (setq o (vlax-ename->vla-object e))))
           (if sBlocks
             (if (member (strcase nm) sBlocks)
               (if Attributes
                 (list (cons nm (apply 'append (mapcar '(lambda (x / v) (if (member (strcase (car (setq v (mapcar '(lambda (p) (vlax-get x p)) '(TagString TextString))))) Attributes) (list v))) (vlax-invoke o 'GetAttributes)))))
                 (list (cons nm (mapcar '(lambda (x) (mapcar '(lambda (p) (vlax-get x p)) '(TagString TextString))) (vlax-invoke o 'GetAttributes))))
               )
             )
             (if Attributes
               (list (cons nm (apply 'append (mapcar '(lambda (x / v) (if (member (strcase (car (setq v (mapcar '(lambda (p) (vlax-get x p)) '(TagString TextString))))) Attributes) (list v))) (vlax-invoke o 'GetAttributes)))))
               (list (cons nm (mapcar '(lambda (x) (mapcar '(lambda (p) (vlax-get x p)) '(TagString TextString))) (vlax-invoke o 'GetAttributes))))
             )
           ); if
         ); lambda
         (ssget "X"
           (list 
             '(0 . "INSERT")
             (cons 2 (apply 'strcat (mapcar '(lambda (x) (strcat x ",")) (append '("`**") (cond (Blocks)('("*")))))))
             '(66 . 1)
           )
         )
       )
     )
   )
 )
 (setq L (mapcar 'cons (mapcar 'car L) (mapcar 'groupbykey (mapcar 'cdr L))))
 (progn
   (DisplayL "Block Data" '(30 20) 
     (cdr 
       (apply 'append
         (mapcar 
           '(lambda (x / tmp)
             (cond 
               ((stringp x) (list "" "" (strcat "=====>> " x " <<=====")))
               ( (append (list "--------------------------- " (strcat (car x) " values:")) (cdr x) '("---------------------------")) )
             )
           )
           (apply 'append L)
         )
       )
     )
   )
 ); progn
 (princ)
); defun


(defun DisplayL ( lbl size L / *error* dcl des dch r )
 
 (defun *error* ( msg )
   (and (< 0 dch) (unload_dialog dch))
   (and (eq 'FILE (type des)) (close des))
   (and (eq 'STR (type dcl)) (findfile dcl) (vl-file-delete dcl))
   (and msg (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\nError: " msg)))) (princ)
 ); defun *error*
 
 (and 
   (vl-consp L) (vl-every '(lambda (x) (eq 'STR (type x))) L) (setq dcl (vl-filename-mktemp nil nil ".dcl")) (setq des (open dcl "w"))
   (princ (strcat "test : dialog { label = \"" lbl "\"; spacer_1; : list_box { key = \"LB\"; width = " (itoa (car size)) "; height = " (itoa (cadr size)) "; } spacer; ok_only; : text { label = \"" (eval (cons 'strcat (mapcar 'chr '(87 114 105 116 116 101 110 32 98 121 32 71 114 114 114 46)))) "\"; } }") des)
   (not (setq des (close des))) (< 0 (setq dch (load_dialog dcl))) (new_dialog "test" dch)
   (progn (start_list "LB") (mapcar 'add_list L) (end_list) (setq r (start_dialog)))
 ); and 
 (*error* nil) r
); defun DisplayL

 

BTW you got nice blocks.

[BIGAL]

You may want to look at Getexcel.lsp its a series of functions that allows you to go both ways take from Autocad put into excel or get from excel it works on row:column so no probs putting a attribute value into the correct cell. Width = 3:5

 

There are a lot of examples search for Title block attributes from excel.

GetExcel.lsp

[sanetmunde]

Thank you for quick response. The code runs good.

 

 

Although this was not what I wanted. But it can be used for other work.

[sanetmunde]

@BIGAL: I tried to use your code. But it shows "CLOSE ALL EXCEL SPREADSHEETS TO CONTINUE!" evenif there is not excelsheet open. Pls look into it.

[BIGAL]

Getexcel is not my code the times I have used it I have not had any problems. I will see if I can find time to double check.