计算给定文本的数字

ReMark · 发表于 2022-7-6 10:56:13

请考虑更改您的个人资料，以反映您实际使用的软件。

Lee Mac · 发表于 2022-7-6 11:00:39

这可能会有更多帮助。。。

我不久前为另一个请求写了这篇文章，并且刚刚对其进行了更新，使其更快。
[列表]

选择要报告的文本

程序将搜索图纸并编译报告

报告显示在表格中
这段代码还将统计属性中找到的文本（但不确定动态块）。


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

编辑：对单个动态块的快速测试我有。。。表明它似乎有效。

stockers · 发表于 2022-7-6 11:02:38

你好
太棒了，谢谢你。
有没有办法使表只返回大于1的数字？
谢谢

Lee Mac · 发表于 2022-7-6 11:04:36

是的，我想澄清一下，你的意思是大于1，还是大于或等于1？

李

stockers · 发表于 2022-7-6 11:08:37

大于1。

由于lisp将在动态块中搜索，但不允许我从中选择要搜索的文本，因此我已经放置了一个包含我希望它搜索的每个可能数字/字母的文本实体。这样的话，模型空间中的每件事都有1个+实际数。
所以我真的认为最好的事情是，如果例程每隔负1返回一次。这将删除等于1的内容，并给出我需要的正确值。
我说得通吗？
我真的很感谢你的帮助，谢谢