我不久前为另一个请求写了这篇文章，并且刚刚对其进行了更新，使其更快。
[列表]
[*]选择要报告的文本
[*]程序将搜索图纸并编译报告
[*]报告显示在表格中
这段代码还将统计属性中找到的文本（但不确定动态块）。
(defun c:tsel (/ *error* unique BPT CATT CNT DOC ENT I ITM J
K LST OBJ OLST SPC SS TBLOBJ TSS UFLAG)
;; by Lee McDonnell (Lee Mac)
(vl-load-com)
(defun *error* (msg)
(and uFlag (vla-EndUndoMark doc))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(princ))
(defun unique (lst / result)
(reverse
(while (setq itm (car lst))
(setq lst (vl-remove itm lst) result (cons itm result)))))
(setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object))
spc (if (zerop (vla-get-activespace doc))
(if (= (vla-get-mspace doc) :vlax-true)
(vla-get-modelspace doc)
(vla-get-paperspace doc))
(vla-get-modelspace doc)) i 2)
(cond ((eq 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (getvar "CLAYER"))))))
(princ "\n<< Current Layer Locked >>"))
(t (if (and (setq k -1 ss(ssget '((0 . "TEXT,MTEXT"))))
(setq bPt (getpoint "\nSelect Point for Table: ")))
(progn
(setq uFlag (not (vla-StartUndoMark doc)))
(while (setq ent (ssname ss (setq k (1+ k))))
(setq lst (cons (cdr (assoc 1 (entget ent))) lst)))
(foreach Str (unique lst)
(setq cnt 0)
(if (setq j -1 tss (ssget "_X" (list '(-4 . "<OR")
'(-4 . "<AND")
'(0 . "TEXT,MTEXT")
(cons 1 str)
'(-4 . "AND>")
'(-4 . "<AND")
'(0 . "INSERT")
'(66 . 1)
'(-4 . "AND>")
'(-4 . "OR>"))))
(while (setq ent (ssname tss (setq j (1+ j))))
(setq Obj (vlax-ename->vla-object ent))
(cond ((eq "AcDbBlockReference" (vla-get-ObjectName Obj))
(foreach Att (append
(vlax-safearray->list
(vlax-variant-value
(vla-getAttributes Obj)))
(if
(not
(vl-catch-all-error-p
(setq cAtt
(vl-catch-all-apply 'vlax-safearray->list
(list
(vlax-variant-value
(vla-getConstantAttributes Obj))))))) cAtt))
(if (eq Str (vla-get-TextString Att)) (setq cnt (1+ cnt)))))
(t (setq cnt (1+ cnt))))))
(setq oLst (cons (cons str cnt) oLst)))
(setq tblObj
(vla-addTable spc
(vlax-3D-point bPt) (+ 2 (length olst)) 2 (* 1.5 (getvar "DIMTXT"))
(* (apply 'max
(mapcar 'strlen
(append '("String")
(apply 'append
(mapcar (function (lambda (x) (list (car x) (itoa (cdr x))))) olst)))))
2.0 (getvar "DIMTXT"))))
(vla-setText tblObj 0 0 "String Counter")
(vla-setText tblObj 1 0 "String")
(vla-setText tblObj 1 1 "Count")
(foreach x (vl-sort olst (function (lambda (a b) (< (car a) (car b)))))
(vla-setText tblObj i 0 (car x))
(vla-setText tblObj i 1 (itoa (cdr x)))
(setq i (1+ i)))
(setq uflag (vla-EndUndoMark doc))))))
(princ))
编辑：对单个动态块的快速测试我有。。。表明它似乎有效。 你好
太棒了，谢谢你。
有没有办法使表只返回大于1的数字？
谢谢
是的，我想澄清一下，你的意思是大于1，还是大于或等于1？
李 大于1。
由于lisp将在动态块中搜索，但不允许我从中选择要搜索的文本，因此我已经放置了一个包含我希望它搜索的每个可能数字/字母的文本实体。这样的话，模型空间中的每件事都有1个+实际数。
所以我真的认为最好的事情是，如果例程每隔负1返回一次。这将删除等于1的内容，并给出我需要的正确值。
我说得通吗？
我真的很感谢你的帮助，谢谢 如果我允许用户选择要添加到要搜索的文本字符串中的块，会更容易吗？
或者，如果代码只是在图形中的每个文本字符串上生成一个报告呢？ 嗯，是的，我想这两种方法都可以。也许选择block值得一试。这对动态块有效吗？
如果上述代码适用于动态块，那么是的，希望如此 试试这个：
5 非常感谢。
这就是工作。那会帮我节省很多时间
干杯
快乐的克林波
J
页:
1
[2]