Jump to content

Data Extraction Existing Excel Sheet


Recommended Posts


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.




Dynamic Blocks Data.xlsx

Dynamic Blocks.dwg

Link to comment
Share on other sites

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)) )
 ); defun MapSS
 (setq L 
     (apply 'append
         (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"
             '(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))))
   (DisplayL "Block Data" '(30 20) 
       (apply 'append
           '(lambda (x / tmp)
               ((stringp x) (list "" "" (strcat "=====>> " x " <<=====")))
               ( (append (list "--------------------------- " (strcat (car x) " values:")) (cdr x) '("---------------------------")) )
           (apply 'append L)
 ); progn
); 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*
   (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.

Link to comment
Share on other sites

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.


Link to comment
Share on other sites

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

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


  • Create New...