我测试了你的Lisp程序,效果很好。唯一的问题是路线项目编号。由于某些原因,项目编号始终位于底部中心。你的代码的哪一部分负责这个?我已经修改了partnum部分并使其工作。
谢谢你的帮助
当做 您需要按照以下要求进行更改。
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
非常感谢你的帮助。问题已解决
顺致敬意, 请帮助我,我需要同样的给我Lisp程序没有图像
提前感谢 plecs,
你说没有图像是什么意思????
也许张贴一张示例图,展示你想要完成的任务。
ymg公司 下面这个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,
我还是不明白,上面的程序不包括任何图像。
也许你的意思是不输出表格???
ymg公司 Lisp它在桌子上,因为他把图像块我做它折叠式家具厨房家具或其他,我需要块的形象
(setq j -1
header_lsp (list "NR. CRT." "LISTA PIESE" "GROSIME" "BUC" "IMAGE") http://mobilamarius.blogspot.ro/
页:
1
[2]