属性提取问题

ADSK2007 · 发表于 2022-7-5 16:25:36

你好

我已经使用附加的lisp很长一段时间了，它做得很好（感谢lisp的创建者）。

我需要在cad文件内创建的表格中再添加几个单元格。下面是我想添加到此lisp中的属性。如果一个字段为空，那么代码应该忽略该字段，然后转到下一个字段。有谁能帮忙吗？

属性包括：

作业编号：
组件编号：
子组件编号：
零件号：

我真的很感激你能帮我做这件事。

当做
BLK数量。lsp

ymg3 · 发表于 2022-7-5 16:31:53

不完全清楚你想要什么。

附加的lisp只需创建一个表格，其中包含图形中的不同块以及每个块的数量。

您希望表格列出每个块的属性标签还是
您需要一个汇总标记值的表。

上传一个包含典型块的样例图形和您想要的输出样例如何。

ymg公司

ADSK2007 · 发表于 2022-7-5 16:34:03

你好，ymg

我一回到家就会上传一个样本文件。这里有更多的解释
我们用属性创建一个块。lisp应该与附加的lisp完全相同，并列出每个块的属性标记。

ADSK2007 · 发表于 2022-7-5 16:37:38

嗨，ymg

附件是我正在寻找的样本文件。

块属性包括：

项目编号/项目编号/装配代码/子装配代码/说明
用户将填充弹出的属性窗口，代码将根据字段中输入的数据合并条目以获得单个零件号。

例子：
项目编号：1988
项目编号：20
零件或组件代码：A
子组件编号：01
说明：桌面

lisp应该组合前4个数据，得到一个用虚线分隔的数字，如下所示-->1988-20-a-01
在表中，我们将有5列，一列表示列表中的项目数，旁边是组合零件号，然后是描述，然后是基于选择区域的块数量，然后是一个小图像，用于识别零件形状（请参见dwg文件中绘制的表）

我非常感谢能得到的任何帮助。
样品图纸

ADSK2007 · 发表于 2022-7-5 16:39:25

这是不可能的，还是我在别人的黑名单中，我不知道？无论如何，我试着自己做，但在某种程度上得到了它；我对Lisp程序的了解不允许我再进一步了。

我已经修改了表并正确地获得了标题，但我无法在表中显示提取的属性。我还需要显示选定块的图像。附件是我到目前为止所拥有的。

再次感谢你能给我的帮助。

当做
样本2。图纸
附件。LSP

ymg3 · 发表于 2022-7-5 16:43:47

ADSK2007，

首先要有耐心。你想要什么都有可能。

然而，必须明确说明问题。现在，目标正在从一个柱子移动到另一个柱子。
我们都是这里的志愿者。

我仍然不清楚是什么让一个区块独一无二。它是零件号还是块名
表中还有项目编号。它只是一个序列号，还是与项目编号标签相关。

ymg公司

ymg3 · 发表于 2022-7-5 16:46:09

这是我到目前为止得到的。

列表可以，但仍然需要您的答案来计算数量。

现在只需输入dummyvalue。

ymg公司

copy


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

ymg3 · 发表于 2022-7-5 16:49:59

现在应该可以增加数量，并对列的对齐方式进行一些更改。

ymg公司

copy


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

BLK数量。LSP

ADSK2007 · 发表于 2022-7-5 16:51:57

您好ymg3

谢谢你的帮助。由于我不能有两个完全相同名称的不同部分，我要说的是，块名称使其唯一，而不是部分名称。因此，让我们通过块名获得数量。
现在，关于“项目名称”的问题-我们不一定填写所有字段-如果一个块只是一个部分，那么我们将在“部分”字段中输入一个数字。如果块由两个组件组成，那么我们给子组件字段加一个“字母”，然后加一个数字。
字母表示组件和子组件，数字仅表示零件。因此，如果我看到一个内部带有字母的零件号，那么我知道它是一个组件的子组件。

今天我将尝试你的代码-再次感谢你在这方面的帮助。

顺致敬意，

ymg3 · 发表于 2022-7-5 16:54:49

当属性不存在时未进行测试。

你可能会得到一些有趣的数字部分。

您所需要做的就是修改我在其中strcat partnum的部分。

ymg公司

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

发表回复

精选推荐