属性提取问题
你好我已经使用附加的lisp很长一段时间了，它做得很好（感谢lisp的创建者）。
我需要在cad文件内创建的表格中再添加几个单元格。下面是我想添加到此lisp中的属性。如果一个字段为空，那么代码应该忽略该字段，然后转到下一个字段。有谁能帮忙吗？
属性包括：
作业编号：
组件编号：
子组件编号：
零件号：
我真的很感激你能帮我做这件事。
当做
BLK数量。lsp
不完全清楚你想要什么。
附加的lisp只需创建一个表格，其中包含图形中的不同块以及每个块的数量。
您希望表格列出每个块的属性标签还是
您需要一个汇总标记值的表。
上传一个包含典型块的样例图形和您想要的输出样例如何。
ymg公司 你好，ymg
我一回到家就会上传一个样本文件。这里有更多的解释
我们用属性创建一个块。lisp应该与附加的lisp完全相同，并列出每个块的属性标记。 嗨，ymg
附件是我正在寻找的样本文件。
块属性包括：
项目编号/项目编号/装配代码/子装配代码/说明
用户将填充弹出的属性窗口，代码将根据字段中输入的数据合并条目以获得单个零件号。
例子：
项目编号：1988
项目编号：20
零件或组件代码：A
子组件编号：01
说明：桌面
lisp应该组合前4个数据，得到一个用虚线分隔的数字，如下所示-->1988-20-a-01
在表中，我们将有5列，一列表示列表中的项目数，旁边是组合零件号，然后是描述，然后是基于选择区域的块数量，然后是一个小图像，用于识别零件形状（请参见dwg文件中绘制的表）
我非常感谢能得到的任何帮助。
样品图纸 这是不可能的，还是我在别人的黑名单中，我不知道？无论如何，我试着自己做，但在某种程度上得到了它；我对Lisp程序的了解不允许我再进一步了。
我已经修改了表并正确地获得了标题，但我无法在表中显示提取的属性。我还需要显示选定块的图像。附件是我到目前为止所拥有的。
再次感谢你能给我的帮助。
当做
样本2。图纸
附件。LSP ADSK2007，
首先要有耐心。你想要什么都有可能。
然而，必须明确说明问题。现在，目标正在从一个柱子移动到另一个柱子。
我们都是这里的志愿者。
我仍然不清楚是什么让一个区块独一无二。它是零件号还是块名
表中还有项目编号。它只是一个序列号，还是与项目编号标签相关。
ymg公司 这是我到目前为止得到的。
列表可以，但仍然需要您的答案来计算数量。
现在只需输入dummyvalue。
ymg公司
(defun c:blkqty (/blk_idblk_len blk_name blks ent h header_lsp heighti
j total len0 lst_blk msp pt objtblsty row ss str tblobj
txtstywidthwidth1 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-setalignmenttblobj 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)
)
现在应该可以增加数量，并对列的对齐方式进行一些更改。
ymg公司
(defun c:blkqty (/*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) "-"(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-setalignmenttblobj 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)
)
BLK数量。LSP 您好ymg3
谢谢你的帮助。由于我不能有两个完全相同名称的不同部分，我要说的是，块名称使其唯一，而不是部分名称。因此，让我们通过块名获得数量。
现在，关于“项目名称”的问题-我们不一定填写所有字段-如果一个块只是一个部分，那么我们将在“部分”字段中输入一个数字。如果块由两个组件组成，那么我们给子组件字段加一个“字母”，然后加一个数字。
字母表示组件和子组件，数字仅表示零件。因此，如果我看到一个内部带有字母的零件号，那么我知道它是一个组件的子组件。
今天我将尝试你的代码-再次感谢你在这方面的帮助。
顺致敬意， 当属性不存在时未进行测试。
你可能会得到一些有趣的数字部分。
您所需要做的就是修改我在其中strcat partnum的部分。
ymg公司
页:
[1]
2