sanetmunde Posted October 24, 2017 Share Posted October 24, 2017 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 Quote Link to comment Share on other sites More sharing options...
Grrr Posted October 24, 2017 Share Posted October 24, 2017 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. Quote Link to comment Share on other sites More sharing options...
BIGAL Posted October 25, 2017 Share Posted October 25, 2017 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 Quote Link to comment Share on other sites More sharing options...
sanetmunde Posted October 27, 2017 Author Share Posted October 27, 2017 Thank you for quick response. The code runs good. Although this was not what I wanted. But it can be used for other work. Quote Link to comment Share on other sites More sharing options...
sanetmunde Posted October 27, 2017 Author Share Posted October 27, 2017 @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. Quote Link to comment Share on other sites More sharing options...
BIGAL Posted October 28, 2017 Share Posted October 28, 2017 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. Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.