[编程交流] 属性提取问题

           (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

(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)
)

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