Jump to content
sanetmunde

Data Extraction Existing Excel Sheet

Recommended Posts

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

Share this post


Link to post
Share on other sites
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.

Share this post


Link to post
Share on other sites
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

Share this post


Link to post
Share on other sites
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.

Share this post


Link to post
Share on other sites
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.

Share this post


Link to post
Share on other sites
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.

Share this post


Link to post
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.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

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