Attribute Extraction problem

Hello

I have been using attached lisp for quite some time and it does a great job for what it has been made to do (Thanks to the creator of the lisp).

I need to add few more cells to the table created inside the cad file. Below are the attributes I would like to add to this lisp. If a field is left empty then the code should ignore that field and move on to next field. Can anyone help with this please?

Attributes are:

Job Number:

Assembly no.:

Sub Assembly No.:

Part No.:

I really appreciate any help I can get with this.

Regards

blkqty.lsp

I need to add few more cells to the table created inside the cad file.

Not completely clear what it is that you want.

The attached lisp simply creates a table of the different blocks in a drawing and how many of each there is.

Do you want the table to list the attribute tags of each block or

you want a table summarizing the tag values.

How about uploading a sample drawing containing the typical blocks and a sample of the output you would like.

ymg

Hello ymg

I will upload a sample file as soon as I get home. Here is a little more explanation

We create a block with attributes. The lisp should do exactly what the attached lisp is doing + list the attribute tags of each block.

Hi ymg

Attached is the sample file for what I am looking for.

The block attributes are:

Project No. / Item Number / Assembly Code / Sub Assembly Code / Description

The user will fill up the attribute window pop up and the code will combine the entry to get a single Part Number based on the data entered in the fields.

Example:

Project number: 1988

Item Number: 20

Part or Assembly Code: A

Sub Asseembly No.: 01

Description: Table top

The lisp should combine the first 4 data to get a single Number separated with a dash line and looks like this --> 1988-20-A-01

inside the table we will have 5 columns, one for number of items in the list, next to it will be the combined part number, then the description, then quantity of blocks based on selection area, then a small image to identify the part shape (Please see the table drawn inside the dwg file)

I greately appreciate any help I can get.

Sample.dwg

Is this not possible or am I in someone's black list and i don't know? Anyway, I tried working on it myself and got it to some extent however; my knowledge of lisp won't allow me to go any further.

I already modified the table and got my titles right but I can't get the extracted attributes to show in the table. I also need to show the image of selected blocks. Attached is what I have so far.

Again, I really appreciate any help you can give me.

Regards

Sample 2.dwg

ATTXT.LSP

ADSK2007,

Is this not possible or am I in someone's black list and i don't know?

First and foremost be patient. Whatever you want is possible.

However the problem has to be clearly stated. Right now from one post to the other the target is moving.

We are all volunteers here.

Still not clear to me Qty, what makes a block unique. Is it Part No. or Block name

You also have Item No. in the table. Is it simply a sequential number or it is related to the item number tag.

ymg

Here's what I got so far.

The list is OK but still need your answer to calculate the qty.

Just putting a dummyvalue right now.

ymg

(defun c:blkqty (/  blk_id  blk_len blk_name blks ent h header_lsp height  i
                          j total len0 lst_blk msp pt objtblsty 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)
    )
 )

 (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) "-"  (cadr attlst) "-" (caddr 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              

        (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 width1 (* 4 (txtwidth "AAAA" h msp))
              width  (* 2 (txtwidth "Text Height" h msp))
              height (* 2 h)
        )

        (if str
           (setq width2 (* 1.5 (txtwidth (strcase str) h msp)))
           (setq width2 width)
        )

        (if (> h 3)
           (setq width  (* (fix (/ width  ) 
                 width1 (* (fix (/ width1 ) 
                 width2 (* (fix (/ width2 ) 
                 height (* (fix (/ height 5)) 5)
           )
        )

        (getorcreatetablestyle "CadEng")

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

        (vla-put-regeneratetablesuppressed tblobj :vlax-true)
        (vla-setcolumnwidth tblobj 0 width1)
        (vla-setcolumnwidth tblobj 1 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))
    
        
       ;(vla-settext tblobj 0 0 "Block Count Table")
       (setq j -1
             header_lsp (list "ITEM NO." "PART NUMBER" "DESCRIPTION" "QTY" "IMAGE")
       )

       (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)
           (vla-settext tblobj row 1 (cadr pt))
           (vla-settext tblobj row 2 (caddr pt))
           (vla-settext tblobj row 3 "qty")
           (vla-setblocktablerecordid tblobj row 4 (getobjectid (vla-item blks blk_name)) :vlax-true)
           (vla-setcellalignment tblobj row 1 7)
           (vla-setcellalignment tblobj row 2 9)
           (setq row (1+ row) i (1+ i))
        )
        (vla-deleterows tblobj 0 1)
        (vla-put-regeneratetablesuppressed tblobj :vlax-false)
        (vlax-release-object tblobj)
    )
 )
 (princ)
)

It should be ok now with quantity plus some change to alignment of columns.

ymg

(defun c:blkqty (/  *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) "-"  (cadr attlst) "-" (caddr 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 "ITEM NO." 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) 5 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 "ITEM NO." "PART NUMBER" "DESCRIPTION" "QTY" "IMAGE")
       )

       (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-setblocktablerecordid tblobj row 4 (getobjectid (vla-item blks blk_name)) :vlax-true)
           (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)
)

blkqty.LSP

Hello ymg3

Thank you for your help. Since I cannot have 2 different part with exact same name, I would say the Block name makes it Unique not the Part name. So lets get the quantity by the block name.

Now your question about the "Item Name" - We don't necessarily fill up all fields - If a block is only a part then we will put a number in the "Part" field. If the block is made of two components then we give a "Letter" to Sub-assembly field then add a number.

Letters mean Assembly and sub-assembly and numbers mean Part only. So if i see a part number with letters inside, then I know it is a sub assembly of an assembly.

I will try your code today - again, Thank you very much for helping me with this.

Best Regards

Did not test when an attribute is not there.

You'll probably get some funny number part.

All you need to do is modify the part where I strcat the partnum.

ymg

Hello ymg3

I tested your lisp and it works perfect. The only issue is the alignment item number. for some reason the item number is always on bottom center. Which part of your code takes care of this? I already modified the partnum part and got it working.

thanks for your help

Regards

You need to change as per below.

ymg

           (vla-setcellalignment tblobj row 0 acmiddleright)   ; change this one
           (vla-setcellalignment tblobj row 1 acmiddleleft)
           (vla-setcellalignment tblobj row 2 acmiddleleft)
           (vla-setcellalignment tblobj row 3 acmiddleright)
           (vla-setcellalignment tblobj row 4 acmiddlecenter) ; and also this one

ymg3

Thank you very much for all your help. Problem solved

Best Regards

pls help me out i need the same to me lisp without image

Thanks in advance

plecs,

What do you mean by without image ????

Maybe post a sample drawing, showing what you want to accomplish.

ymg

this lisp below you must not be modified image. I want to be free image

(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) 5 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" [color="red"]"IMAGE"[/color])
       )

       (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-setblocktablerecordid tblobj row 4 (getobjectid (vla-item blks blk_name)) :vlax-true)
           (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)
)

Lisp it in the table as he put the image block I do it folosec furniture kitchen furniture or otherwise and I need to block image

to be changed, not to be image. I want to be no image

plecs,

I still do not understand, the above program does not include any image.

Maybe you mean not outputting the table???

ymg

Lisp it in the table as he put the image block I do it folosec furniture kitchen furniture or otherwise and I need to block image

(setq j -1
             header_lsp (list "NR. CRT." "LISTA PIESE" "GROSIME" "BUC" [color="red"]"IMAGE"[/color])