Attribute Extraction problem

[ymg3]

plecs,

 

Change this line:

 

(getorcreatetablestyle "CadEng")

        (setq pt     (getpoint "\nPlace Table :")
              tblobj (vla-addtable msp (vlax-3d-point pt) (+ (length lst_blk) 2) [color="red"]4[/color] height width)
        )

 

 

And below the whole code with the changes (not tested):

 

 

 

and finally delete this line:

 

also here:

 

(setq j -1
             header_lsp (list "NR. CRT." "LISTA PIESE" "GROSIME" "BUC")
       )

 

And finally delete the following line or put a semi-colon in front of it:

 

(vla-setblocktablerecordid tblobj row 4 (getobjectid (vla-item blks blk_name)) :vlax-true)

 

 

(defun c:blkqty5 (/  *adoc *h* *util attlst blk_id  blk_len blk_name blks desc en entlst h
                   header_lsp horizmargin height i j total len0 lst_blk msp pt objtblsty
                   partnum row ss str tblobj txtsty width width1 width2 x y)
               
 (vl-load-com)
 
 (defun txtwidth (val h msp / txt minp maxp)

    (setq txt (vla-addtext msp val (vlax-3d-point '(0 0 0)) h))
    (vla-getboundingbox txt 'minp 'maxp)
    (vla-erase txt)
    (- (car (vlax-safearray->list maxp)) (car (vlax-safearray->list minp)))
 )

 (defun getorcreatetablestyle (tbl_name / name namelst objtblsty objtblstydic tablst txtsty)
    (setq objtblstydic (vla-item (vla-get-dictionaries *adoc) "ACAD_TABLESTYLE"))
    (foreach itm (vlax-for itm objtblstydic (setq tablst (append tablst (list itm))))
        (if (not (vl-catch-all-error-p (setq name (vl-catch-all-apply 'vla-get-name (list itm)))))
           (setq namelst (append namelst (list name)))
        )
    )
    (if (not (vl-position tbl_name namelst))
       (vla-addobject objtblstydic tbl_name "AcDbTableStyle")
    )
    (setq objtblsty (vla-item objtblstydic tbl_name)
             txtsty (variant-value (vla-getvariable *adoc "TextStyle"))
    )
    (mapcar '(lambda (x) (vla-settextstyle objtblsty x txtsty)) (list actitlerow acheaderrow acdatarow));
    (vla-setvariable *adoc "CTableStyle" tbl_name)
 )

 (defun getobjectid (obj)
    (if (vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE"))
       (vlax-invoke-method *util 'getobjectidstring obj :vlax-false)
       (vla-get-objectid obj)
    )
 )

 (defun quantity (lst / item qty rtn)
    (while lst
       (setq item (car lst)
              qty 1
              lst (cdr lst)
       )      
       (while  (= (cadr item) (cadr (car lst)))
           (setq qty (1+ qty)
                 lst (cdr lst)
           )
       )
       (setq rtn (cons (append item (list qty)) rtn))
    )
    (reverse rtn)
 )      

 (if (setq ss (ssget (list (cons 0 "INSERT"))))
    (progn
        (setq i -1 lst_blk nil)      
        (while (setq en (ssname ss (setq i (1+ i))))
            (setq entlst (entget en)
                  blk_name (cdr (assoc 2 entlst))
                    attlst nil
            )      
            (while (/= (cdr (assoc 0 entlst)) "SEQEND")
                (if (= (cdr (assoc 0 entlst)) "ATTRIB")
            (setq attlst (cons (cdr (assoc 1 entlst)) attlst))
                )
                (setq entlst (entget (setq en (entnext en))))
            )
            (setq    desc (car attlst)
                   attlst (reverse (cdr attlst))
                  partnum (strcat (car attlst) " x "  (cadr attlst)  " - " (cadddr attlst)) 
                  lst_blk (cons (list blk_name partnum desc) lst_blk)
            )
        )

        (setq lst_blk (vl-sort lst_blk '(lambda (x y) (< (cadr x) (cadr y)))))

        ;; Here we need to remove duplicate and add qty to lst_blk
        (setq lst_blk (quantity lst_blk))

        (or *h* (setq *h* (* (getvar "dimtxt") (getvar "dimscale"))))
        (initget 6)
        (setq h (getreal (strcat "\nText Height <" (rtos *h*) "> :")))
        (if h (setq *h* h)(setq h *h*))

        (or *adoc (setq *adoc (vla-get-activedocument (vlax-get-acad-object))))
        (setq msp   (vla-get-modelspace *adoc)
              *util (vla-get-utility *adoc)
              blks  (vla-get-blocks *adoc)
        )

        (setq horizmargin h
              width1 (+ horizmargin (txtwidth "NR. CRT." h msp) horizmargin)
              width2 (+ horizmargin (txtwidth (cadr (car lst_blk)) h msp) horizmargin)
              width  (+ (* (+ width1 width2) 2) (* width2 1.5))
              height (* 2 h)
        )

               
        (getorcreatetablestyle "CadEng")

        (setq pt     (getpoint "\nPlace Table :")
              tblobj (vla-addtable msp (vlax-3d-point pt) (+ (length lst_blk) 2) 4 height width)
        )

        ;(vla-put-regeneratetablesuppressed tblobj :vlax-true)
        (vla-setcolumnwidth tblobj 0 width1)
        (vla-setcolumnwidth tblobj 1 width2)
        (vla-setcolumnwidth tblobj 2 (* width2 1.5))
        (vla-setcolumnwidth tblobj 3 width1)
        (vla-setcolumnwidth tblobj 4 width2)
        (vla-put-vertcellmargin tblobj (* 0.75 h))
        (vla-put-horzcellmargin tblobj (* 0.75 h))
        (mapcar '(lambda (x) (vla-settextheight tblobj x h)) (list actitlerow acheaderrow acdatarow))
        (mapcar '(lambda (x) (vla-setalignment  tblobj x ) (list actitlerow acheaderrow acdatarow))
    
        
       
       (setq j -1
             header_lsp (list "NR. CRT." "LISTA PIESE" "GROSIME" "BUC")
       )

       (repeat (length header_lsp)
           (vla-settext tblobj 1 (setq j (1+ j)) (nth j header_lsp))
       )

       (setq row 2 i 1)
       (foreach pt lst_blk
           (setq blk_name (car pt)
                        j  -1
           )
           (vla-settext tblobj row 0 i)           ; ITEM NO.    
           (vla-settext tblobj row 1 (cadr pt))   ; PART NUMBER 
           (vla-settext tblobj row 2 (caddr pt))  ; DESCRIPTION 
           (vla-settext tblobj row 3 (cadddr pt)) ; QTY         
           
           (vla-setcellalignment tblobj row 1 acmiddleright)
           (vla-setcellalignment tblobj row 1 acmiddleleft)
           (vla-setcellalignment tblobj row 2 acmiddleleft)
           (vla-setcellalignment tblobj row 3 acmiddleright)
           (vla-setcellalignment tblobj row 3 acmiddlecenter)
           (setq row (1+ row) i (1+ i))
        )
        (vla-deleterows tblobj 0 1)
        ;(vla-put-regeneratetablesuppressed tblobj :vlax-false)
        (vlax-release-object tblobj)
    )
 )
 (princ)
)

 

ymg

[plecs]

Thanks I like now

[claudiokad]

hi, please help, autocad 2007 error,

Command: blkqty5

Select objects: 1 found

Select objects: 1 found, 2 total

Select objects:

Text Height :

Place Table :; error: Automation Error. Invalid input

[claudiokad]

Hi! I need help, the following code, presents the data in column, I need to present them in lines, example 1! 2! 3! 4! 5 this data line has reference the attributes of a block, follow code, thanks

 

 

 

;;-----------------=={ Count Attribute Values }==-------------;;
;;                                                            ;;
;;  Counts the number of occurrences of attribute values in a ;;
;;  selection of attributed blocks. Displays result in an     ;;
;;  AutoCAD Table object.                                     ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;

(defun c:CAV nil (c:CountAttributeValues))

(defun c:CountAttributeValues ( / _Dxf _Assoc++ _SumAttributes ss i alist )

 (defun _Dxf ( key alist ) (cdr (assoc key alist)))

 (defun _Assoc++ ( key alist )
   (
     (lambda ( pair )
       (if pair
         (subst (list key (1+ (cadr pair))) pair alist)
         (cons  (list key 1) alist)
       )
     )
     (assoc key alist)
   )
 )

 (defun _SumAttributes ( entity alist )
   (while
     (not
       (eq "SEQEND"
         (_dxf 0
           (entget
             (setq entity
               (entnext entity)
             )
           )
         )
       )
     )
     (setq alist (_Assoc++ (_Dxf 1 (reverse (entget entity))) alist))
   )
 )

 (cond
   (
     (not
       (vlax-method-applicable-p
         (setq space
           (vlax-get-property
             (setq doc
               (vla-get-ActiveDocument (vlax-get-acad-object))
             )
             (if (= 1 (getvar 'CVPORT)) 'Paperspace 'Modelspace)
           )
         )
         'AddTable
       )
     )

     (princ "\n** This Version of AutoCAD Does not Support Tables **")
   )
   (
     (and (setq ss (ssget '((0 . "INSERT") (66 . 1))))
       (repeat (setq i (sslength ss))
         (setq alist (_SumAttributes (ssname ss (setq i (1- i))) alist))
       )
       (setq pt (getpoint "\n Ponto de Inserção da Tabela: "))
     )
    
     (LM:AddTable space (trans pt 1 0) "DESCRIÇÃO DE MEDIDAS"
               (cons '("Cod.:" "Descrição:" "Qtda.:" "Seq.:" "Largura:" "Altura:" "Esp.:")
         (vl-sort
           (mapcar
             (function
               (lambda ( pair )
                 (list (car pair) (itoa (cadr pair)))
               )
             )
             alist
           )
           (function (lambda ( a b ) (< (strcase (car a)) (strcase (car b)))))
         )
       )
     )
   )
 )

 (princ)
)

;;---------------------=={ Add Table }==----------------------;;
;;                                                            ;;
;;  Creates a VLA Table Object at the specified point,        ;;
;;  populated with title and data                             ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  space - VLA Block Object                                  ;;
;;  pt    - Insertion Point for Table                         ;;
;;  title - Table title                                       ;;
;;  data  - List of data to populate the table                ;;
;;------------------------------------------------------------;;
;;  Returns:  VLA Table Object                                ;;
;;------------------------------------------------------------;;

(defun LM:AddTable ( space pt title data / _itemp ) (vl-load-com)

 (defun _itemp ( collection item )
   (if
     (not
       (vl-catch-all-error-p
         (setq item
           (vl-catch-all-apply 'vla-item (list collection item))
         )
       )
     )
     item
   )
 )

 (
   (lambda ( table ) (vla-put-StyleName table (getvar 'CTABLESTYLE)) (vla-SetText table 0 0 title)
     (
       (lambda ( row )
         (mapcar
           (function
             (lambda ( rowitem ) (setq row (1+ row))
               (
                 (lambda ( column )
                   (mapcar
                     (function
                       (lambda ( item )
                         (vla-SetText table row
                           (setq column (1+ column)) item
                         )
                       )
                     )
                     rowitem
                   )
                 )
                 -1
               )
             )
           )
           data
         )
       )
       0
     )
     table
   )
   (
     (lambda ( textheight )
       (vla-AddTable space (vlax-3D-point pt) (1+ (length data)) (length (car data)) (* 1. textheight)
         (* textheight
           (apply 'max
             (cons (/ (strlen title) (length (car data)))
               (mapcar 'strlen (apply 'append data))
             )
           )
         )
       )
     )
     (vla-getTextHeight
       (_itemp
         (_itemp
           (vla-get-Dictionaries
             (vla-get-ActiveDocument (vlax-get-acad-object))
           )
           "ACAD_TABLESTYLE"
         )
         (getvar 'CTABLESTYLE)
       )
       acDataRow
     )
   )
 )
)

(princ)