Author Topic: dynamic block with attributes extraction to excel  (Read 5541 times)

0 Members and 1 Guest are viewing this topic.

astro86

  • Guest
dynamic block with attributes extraction to excel
« 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...

Quote

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.


Code: [Select]
;;************************************************************

;; 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! ***|;
« Last Edit: December 17, 2009, 05:28:40 AM by astro86 »

Sebb77

  • Guest
Re: dynamic block with attributes extraction to excel
« Reply #1 on: December 17, 2009, 05:04:09 PM »

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.

fixo

  • Guest
Re: dynamic block with attributes extraction to excel
« Reply #2 on: December 18, 2009, 05:20:50 PM »
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

Code: [Select]

;;  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'~
« Last Edit: January 04, 2010, 11:21:33 AM by fixo »

astro86

  • Guest
Re: dynamic block with attributes extraction to excel
« Reply #3 on: January 04, 2010, 04:51:30 AM »
Hi, Happy new year to you and thank you for your reply.
I tested your lisp and got following error message.

Quote
Command:
   ***       Start command with BOUT...     ***
Command:
Command: bout
; error: no function definition: GETPROPVALUE

Thank's again for your help  :-)

fixo

  • Guest
Re: dynamic block with attributes extraction to excel
« Reply #4 on: January 04, 2010, 11:25:32 AM »
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'~