TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: astro86 on December 17, 2009, 05:22:46 AM
-
Hi all,
I need to extract attributes from dynamic blocks to excel.
The -attout command is good but i need more informations like visibility state and so on...
The extraction wizard export all this informations but not the Handle...
So what i need is:
Export all the attributes of the blocks (if possible with a predefined list of blocks)
+handle id of the blocks
+visibility state
+Real blockname (with -attout command the block names look like *U18, *U72 ....)
Maybee somebody has already a lisp routine which does this
Hope somebody can help me. Thanks in advance for your support!
I posted this topic alos on cadtutor, here is the code, but it's not exactly what i wanted...
THis was wrong with the code:
-is it possible to get the outputformat to an xls with tab delimited tabs an titles on the header?
-when the handle id is something like 48E8, excel interprets it like 4.80E+09 so --> 4800000000
with -attout command the handle is '48E8 and then excel recognize it
-last one is, i need the visibility state of my dynamic block. Not if it's visible or not. So my dynamic block can have up to 20 visibility states e.g. and i need them in the excel.
;;************************************************************
;; Design by Gabo CALOS DE VIT from CORDOBA ARGENTINA
;;; Copyleft 1995-2009 by Gabriel Calos De Vit
;; DEVITG@GMAIL.COM
;;-*******************************************************************************************************************************
(DEFUN guarda-lista-csv-w (lista
/
ar
;;; nombre-archivo
)
(SETQ nombre-archivo
(STRCAT (GETVAR "dwgprefix")
(VL-FILENAME-BASE (GETVAR "dwgname"))
".csv"))
(SETQ ar (OPEN nombre-archivo "w"))
(FOREACH texto lista
(WRITE-LINE texto ar)
)
(CLOSE ar)
)
;;-*******************************************************************************************************************************
;;;---------------------------------------------------------------------------------------------------------
;;*//*/*/*/*/*/*/*/*/*/*/*/*/**/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/
;;;Juerg Menzi
;;;MENZI ENGINEERING GmbH, Switzerland
;;;http://www.menziengineering.ch
; == Function MeGetAtts
; Reads all attribute values from a block
; Arguments [Typ]:
; Obj = Object [VLA-OBJECT]
; Return [Typ]:
; > Dotted pair list '(("Tag1" . "Val1")...)[list]
; Notes:
; None
;
(defun MeGetAtts (Obj)
(mapcar
'(lambda (Att)
(cons
(vla-get-TagString Att)
(vla-get-TextString Att)
)
)
(vlax-invoke Obj 'GetAttributes)
)
)
;;*//*/*/*/*/*/*/*/*/*/*/*/*/**/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*
;; TASK TO DO
;;;Export all the attributes
;;;+handle id of the blocks
;;;+visibility state
;;;+Real blockname
(defun GET-NAME+HANDLE+VISIBLE+ATTs ( /
ACAD* ADOC ALL-INSERTED-CSV-LIST ALL-INSERTED-DATA-LIST ATT-PAIR-LIST CSV-LIST DATA-LIST DATA-LIST< HANDLE nombre-archivo INSERTED-CSV INSERTED-LIST INSERTED-SS NAME VISIBLE
)
(vl-load-com)
(setq acad* (vlax-get-acad-object)) ;_ ACAD
(setq adoc (vla-get-activedocument acad*)) ;_ DWG active
(setq insertED-SS (ssget "_X" '(( 0 . "insert"))));_ all inserted blocks
(setq inserted-list (mapcar 'vlax-ename->vla-object (vl-remove-if-not '(lambda(x)(= (type x) 'ENAME)) (mapcar 'cadr (ssnamex insertED-SS)))));_ a list of inserted
(setq all-inserted-csv-list nil)
(setq all-inserted-data-list nil)
(foreach inserted inserted-list
(setq data-list nil)
(setq csv-list nil)
(setq name (vla-get-EffectiveName inserted))
(setq data-list (cons (cons "NAME" name) data-list))
(setq handle (vla-get-Handle inserted))
(setq data-list (cons (CONS "HANDLE" handle) data-list))
(setq visible (if (vla-get-Visible inserted)
"visible"
"no visible"
);_ if
);_ visible
(setq data-list (cons (cons "VISIBLE" visible) data-list))
(setq csv-list (reverse(list name handle visible ) ))
(if (vla-get-hasAttributes inserted )
(progn
(setq att-pair-list (MeGetAtts inserted))
(foreach att-pair att-pair-list
(setq data-list ( cons att-pair data-list))
(setq csv-list (cons (Cdr att-pair) csv-list))
)
);_ progn
);If has attribute
(setq inserted-csv (list$2cvs (reverse csv-list)))
(setq data-list< (reverse data-list))
(setq all-inserted-data-list (cons data-list< all-inserted-data-list))
(setq all-inserted-csv-list (cons inserted-csv all-inserted-csv-list))
);_ foreach inserted
(setq blk-qty (length all-inserted-csv-list))
(guarda-lista-csv-w all-inserted-csv-list)
(alert (strcat "\n Data form : \n " (Itoa blk-qty) " BLOCKS \n has been sent to .. \n" nombre-archivo ))
(princ)
);_ defun
;;*//*/*/*/*/*/*/*/*/*/*/*/*/**/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*
(defun c:dyn-dat ()
(GET-NAME+HANDLE+VISIBLE+ATTs)
)
;;*//*/*/*/*/*/*/*/*/*/*/*/*/**/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*
;;*//*/*/*/*/*/*/*/*/*/*/*/*/**/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/
(defun list$2cvs (#lst)
(if (not ( listp #lst))
(setq #lst (list #lst))
)
(apply 'strcat
(cons (car #lst)
(mapcar '(lambda (str) (strcat "," str))
(cdr #lst)
) ;_mapcar
) ;_cons
) ;_apply
) ;_ string-list2cvs
;;;usage(string-list2cvs '("One" "Two" "Three"))
;;;->"One,Two,Three"
;;*//*/*/*/*/*/*/*/*/*/*/*/*/**/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/
(prompt "prompt DYN-DAT at the command line")
;|«Visual LISP© Format Options»
(72 2 1 0 nil "end of " 100 20 2 0 0 nil T nil T)
;*** DO NOT add text below the comment! ***|;
-
When sending numbers to an Excel spreadsheet, i noticed DIMZIN has to be set to 0 to keep wanted format.
Use VLA-GET-EFFECTIVENAME to extract real names of dynamic blocks.
I hope this can help you moving forward.
-
The following lisp was written few years ago
Keep in mind I haven't dynamic blocks with attributes
in my garbage so I can't test it on my machine
Better yet to drop few block and try posting the drawing
in an attachment
;; Groups elements in sublist by test
(defun subtrack (test lst)
(apply 'append
(mapcar '(lambda (x)
(if (eq (car x) test)
(list x)))
lst)))
;; Counts equivalent items in list
(defun countsub (lst sub)
(cond ((null lst) 0)
((and (equal (caar lst) (car sub) 0.00001)
(equal (cadar lst) (cadr sub) 0.00001)
)
(1+ (countsub (cdr lst) sub))
)
(T (countsub (cdr lst) sub))
)
)
;; get attributes from block include constant attributes
(defun get-all-atts (obj / atts att_list const_atts const_list ent)
(and
(if (and obj
(vlax-property-available-p obj 'Hasattributes)
(eq :vlax-true (vla-get-hasattributes obj))
)
(progn
(setq atts (vlax-invoke obj 'Getattributes))
(foreach att atts
(setq att_list
(cons (cons (vla-get-tagstring att)
(vla-get-textstring att)
)
att_list
)
)
)
)
)
)
(cond ((vlax-method-applicable-p obj 'Getconstantattributes)
(setq const_atts (vlax-invoke obj 'Getconstantattributes))
(foreach att const_atts
(setq const_list
(cons (cons (vla-get-tagstring att)
(vla-get-textstring att)
)
const_list
)
)
)
(setq att_list (reverse (append const_list att_list)))
)
(T (reverse att_list))
)
)
;;get dynamic property value by name ;;
(defun getpropvalue (blk prop_name)
(variant-value
(vla-get-value
(car
(vl-remove-if-not
(function (lambda (x)
(eq prop_name (vla-get-propertyname x))))
(vlax-safearray->list
(variant-value
(vla-getdynamicblockproperties blk)))))
)
)
)
;; Main part ;;
(defun C:BOUT (/ acsp adoc aexc awb axss
bname cll colm com_data csht data
exc_data fname header_list info nwb
obj osm row sht ss str1 str2
subtot tmp_data tmp_get tmp_snip tot
)
(vl-load-com)
(setq adoc (vla-get-activedocument
(vlax-get-acad-object)
)
acsp (vla-get-modelspace adoc)
)
(vl-cmdf "zoom" "a")
(vl-cmdf "zoom" ".85x")
(setq ss (ssget "_X" (list (cons 0 "INSERT")
(cons 2 "`*U*,Test*")
)))
(setq com_data nil) ;for debug only
(while (setq en (ssname ss 0))
(setq obj (vlax-ename->vla-object en))
(if (eq :vlax-true (vla-get-isdynamicblock obj))
(progn
(setq tmp_get (get-all-atts obj))
(setq tmp_data
(append (list (vla-get-effectivename obj)
(vla-get-handle obj)(getpropvalue obj "Visibility"))
tmp_get))
(setq com_data (cons tmp_data com_data))
(setq tmp_data nil))
)
(princ (strcat "\nVisibility State: " (getpropvalue obj "Visibility")))
(ssdel en ss)
)
(setq tot (length com_data))
(setq exc_data nil) ;for debug only
(while com_data
(setq tmp_snip
(subtrack (caar com_data) com_data)
)
(setq str1 (strcat "Subtotal blocks "
"\"" (caar com_data) "\""
": "
)
str2
(itoa (length tmp_snip))
)
(setq exc_data (append exc_data
(list (append tmp_snip (list (list str2 str1))))
)
com_data (vl-remove-if
(function not)
(mapcar (function (lambda (x)
(if (not (member x tmp_snip))
x
)
)
)
com_data
)
)
tmp_snip nil
)
)
(setq exc_data
(mapcar (function (lambda (x)
(mapcar (function (lambda (y)
(append (list (cadr y)(car y))(cddr y))))
x
)
)
)
exc_data)
)
;; Eof calc part ;;
;; *** Excel part *** ;;
(alert "Save Excel manually after")
(setq fn (vl-filename-base (getvar "dwgname")))
(setq fname (strcat (getvar "dwgprefix") fn ".xls"))
;;create xls file
(if (findfile fname)
(progn
(alert (strcat "File " "\"" fname "\"" "does exist\nEnter another name"))
(setq fn (getstring "\nEnter the file name without extension: "))
(setq fname (strcat (getvar "dwgprefix") fn ".xls"))))
(setq fname (open fname "W"))
(close fname)
(alert (strcat "Select file " "\"" (strcat fn ".xls") "\""))
(setq fname (getfiled "Excel Spreadsheet File" "" "XLS" 8))
(setq fname (findfile fname))
;;; Excel part based on lisp written by ALEJANDRO LEGUIZAMON - http://arquingen.tripod.com.co
(setq aexc (vlax-get-or-create-object "Excel.Application")
awb (vlax-get-property aexc "Workbooks")
nwb (vlax-invoke-method awb "Open" fname)
sht (vlax-get-property nwb "Sheets")
csht (vlax-get-property sht "Item" 1)
cll (vlax-get-property csht "Cells")
)
(vlax-put-property csht 'Name "AttOut-AttIn")
(vla-put-visible aexc :vlax-true)
(setq row 1
colm 1
)
(setq header_list
'("HANDLE"
"BLOCK NAME"
"VISIBILITY"
"TAG1"
"TAG2"
"TAG3"
"TAG4"
"TAG5"
"TAG6"
"TAG7"
"TAG8"
"TAG9"
"TAG10"
)
) ;_ end of setq
(repeat (length header_list)
(vlax-put-property
cll
"Item"
row
colm
(vl-princ-to-string (car header_list))
)
(setq colm (1+ colm)
header_list
(cdr header_list)
)
)
(setq row 2
colm 1
)
(repeat (length exc_data)
(setq data (reverse (cdr (reverse (car exc_data))))
subtot (last (car exc_data))
)
(repeat (length data)
(setq info (car data))
(repeat (length info)
(vlax-put-property
cll
"Item"
row
colm
(if (< colm 4)
(vl-princ-to-string (car info))
(vl-princ-to-string (cdar info)))
)
(setq colm (1+ colm))
(setq info (cdr info))
)
(setq data (cdr data))
(setq row (1+ row)
colm 1
)
)
(vlax-put-property
cll
"Item"
row
colm
(vl-princ-to-string (car subtot))
)
(setq colm (1+ colm))
(vlax-put-property
cll
"Item"
row
colm
(vl-princ-to-string (cadr subtot))
)
(setq exc_data (cdr exc_data))
(setq row (1+ row)
colm 1
)
)
(setq row (1+ row)
colm 1
)
(vlax-put-property
cll
"Item"
row
colm
(vl-princ-to-string "TOTAL BLOCKS:")
)
(setq colm (1+ colm))
(vlax-put-property
cll
"Item"
row
colm
(vl-princ-to-string tot)
)
(setq fcol (vlax-get-property csht "Range" "A:Z"))
(vlax-put-property fcol "NumberFormat" "@")
(vlax-invoke (vlax-get-property csht "Columns") "AutoFit")
(mapcar
(function (lambda (x)
(vl-catch-all-apply
(function (lambda ()
(progn
(if x
(vlax-release-object x)(setq x nil))))))))
(list cll
fcol
csht
sht
bwb
awb
aexc)
)
(setq aexc nil)
(gc)
(gc)
(princ)
)
(princ "\n\t\t***\tStart command with BOUT...\t***")
(princ)
~'J'~
-
Hi, Happy new year to you and thank you for your reply.
I tested your lisp and got following error message.
Command:
*** Start command with BOUT... ***
Command:
Command: bout
; error: no function definition: GETPROPVALUE
Thank's again for your help :-)
-
Command:
*** Start command with BOUT... ***
Command:
Command: bout
; error: no function definition: GETPROPVALUE
Sorry I'm sick now, just had changed slightly lisp above
Try to change yourself to your suit
~'J'~