ADSK2007 发表于 2022-7-5 16:58:14

您好ymg3
 
我测试了你的Lisp程序,效果很好。唯一的问题是路线项目编号。由于某些原因,项目编号始终位于底部中心。你的代码的哪一部分负责这个?我已经修改了partnum部分并使其工作。
谢谢你的帮助
 
当做

ymg3 发表于 2022-7-5 17:02:21

您需要按照以下要求进行更改。
 
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

ADSK2007 发表于 2022-7-5 17:06:07

ymg3
 
非常感谢你的帮助。问题已解决
 
顺致敬意,

plecs 发表于 2022-7-5 17:09:51

请帮助我,我需要同样的给我Lisp程序没有图像
 
提前感谢

ymg3 发表于 2022-7-5 17:11:03

plecs,
 
你说没有图像是什么意思????
 
也许张贴一张示例图,展示你想要完成的任务。
 
ymg公司

plecs 发表于 2022-7-5 17:14:46

下面这个Lisp程序的图片你一定不能修改。我想成为自由的形象
(defun c:blkqty5 (/*adoc *h* *util attlst blk_idblk_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-setalignmenttblobj x ) (list actitlerow acheaderrow acdatarow))
   
      
      
       (setq j -1
             header_lsp (list "NR. CRT." "LISTA PIESE" "GROSIME" "BUC" "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)
)
 
 
Lisp它在桌子上,因为他把图像块我做它折叠式家具厨房家具或其他,我需要块的形象

plecs 发表于 2022-7-5 17:19:15

要改变,不要成为形象。我不想成为任何形象

ymg3 发表于 2022-7-5 17:22:00

plecs,
 
我还是不明白,上面的程序不包括任何图像。
 
也许你的意思是不输出表格???
 
ymg公司

plecs 发表于 2022-7-5 17:23:05

Lisp它在桌子上,因为他把图像块我做它折叠式家具厨房家具或其他,我需要块的形象
(setq j -1
             header_lsp (list "NR. CRT." "LISTA PIESE" "GROSIME" "BUC" "IMAGE")

plecs 发表于 2022-7-5 17:28:22

http://mobilamarius.blogspot.ro/
页: 1 [2]
查看完整版本: 属性提取问题