统计属性值
块名称门标记标签XF
值D06
如何计算具有上述值的块数。 试试这个：
(defun c:test (/ no)
;; Tharwat 30.9.2015 ;;
(setq no 0)
(vlax-for lay (vla-get-layouts
(vla-get-activedocument (vlax-get-acad-object))
)
(vlax-for spc (vla-get-block lay)
(if (and (eq (vla-get-objectname spc) "AcDbBlockReference")
(eq (vla-get-effectivename spc) "DOOR TAG")
(eq (vla-get-hasattributes spc) :vlax-true)
(vl-some '(lambda (x)
(and (eq (vla-get-tagstring x) "XF")
(eq (vla-get-textstring x) "D06")
)
)
(vlax-invoke spc 'getattributes)
)
)
(setq no (1+ no))
)
)
)
(princ (if (< 0 no) (strcat "\nNumber of Blocks < " (itoa no) " > .") "\nZero found !"))
(princ)
)(vl-load-com)
未经测试的一点粗糙可以做得更好，未经测试
(vl-load-com)
(defun c:blocknum ( / bname tagname )
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
(setq bname (strcase (getstring "\nEnter block name")))
(setq tagname (strcase (getstring "\nEnter Block tag")))
(vlax-for block (vla-get-blocks adoc)
(if (= (strcase (vla-get-name block)) bname)
(progn
(foreach att block 'getattributes)
(if (= tagname (strcase (vla-get-tagstring att)))
(setq x (+ 1x))
)
)
) ; progn
) ;_ end of if
) ;_ end of vlax-for block
(alert (strcat blockname " has " (rtos x 2 0) "with tag " tagname))
(princ)
) ;-end of defun
(princ)
*的目的是什么？？此lisp是否适用于只有一个标记的块？我在一个有两个标签的街区上试过了，但没法用？ 以下是一个通用程序，用于计算具有给定标记/值的属性块，仅使用Vanilla AutoLISP在Mac上兼容：
(defun c:countattblocks ( / blk ent enx idx rtn sel tag val )
(while
(not
(or
(= "" (setq blk (strcase (getstring t "\nSpecify block name: "))))
(tblsearch "block" blk)
)
)
(princ (strcat "\nBlock " blk " not found."))
)
(if (and (/= "" blk) (setq tag (strcase (getstring "\nSpecify attribute tag: "))))
(progn
(setq val (strcase (getstring t "\nSpecify attribute value: "))
rtn 0
)
(if
(and
(setq sel
(ssget "_X"
(list
'(00 . "INSERT")
'(66 . 1)
(cons 02 (strcat "`*U*," blk))
(if (= 1 (getvar 'cvport))
(cons 410 (getvar 'ctab))
'(410 . "Model")
)
)
)
)
(progn
(repeat (setq idx (sslength sel))
(setq ent (ssname sel (setq idx (1- idx))))
(if (= blk (strcase (LM:name->effectivename (cdr (assoc 2 (entget ent))))))
(progn
(setq ent (entnext ent)
enx (entgetent)
)
(while
(and (= "ATTRIB" (cdr (assoc 0 enx)))
(not
(and
(= tag (strcase (cdr (assoc 2 enx))))
(= val (strcase (cdr (assoc 1 enx))))
(setq rtn (1+ rtn))
)
)
)
(setq ent (entnext ent)
enx (entgetent)
)
)
)
)
)
(< 0 rtn)
)
)
(princ
(strcat
"\nFound " (itoa rtn) " " blk " block" (if (= 1 rtn) "" "s")
" with attribute tag " tag " with value " val "."
)
)
(princ (strcat "\nNo " blk " blocks found with attribute tag " tag " with value " val "."))
)
)
)
(princ)
)
;; Block Name -> Effective Block Name-Lee Mac
;; blk - Block name
(defun LM:name->effectivename ( blk / rep )
(if
(and (wcmatch blk "`**")
(setq rep
(cdadr
(assoc -3
(entget
(cdr (assoc 330 (entget (tblobjname "block" blk))))
'("AcDbBlockRepBTag")
)
)
)
)
(setq rep (handent (cdr (assoc 1005 rep))))
)
(cdr (assoc 2 (entget rep)))
blk
)
)
(princ) 绝对，绝对整洁！！thx李
谢谢你Steve 对不起，伙计们，当我粘贴的时候，一些额外的字符出现了，但不知道为什么。
Tharwat你一定在我面前张贴了秒，我不会张贴。
李像往常一样在班上名列前茅。 是否可以通过单击进行块和属性选择？也许这个选项会更有效率？
页:
[1]