社区 › Auto Lisp › 按层或图案填充区域

Baber62 发表于 2022-7-5 15:51:30

按层或图案填充区域

我正在寻找一个lisp例程，该例程将整个图形或图形中选定区域的图层和/或图案填充区域导出到excel文件。
 
我有大量的图纸，我必须通过（超过100），并必须准备一份工程量清单。如有任何帮助，我们将不胜感激。

ronjonp 发表于 2022-7-5 16:05:24

这里有一个简单的例子：
(defun c:hareas        (/ _writefile a b key out s)
(defun _writefile (filename lst / file)
   (cond ((and (eq 'str (type filename)) (setq file (open filename "w")))
   (foreach x lst (write-line x file))
   (close file)
   filename
)
   )
)
(initget 0 "Pattern Layer")
(if (and (or (setq key (getkword "\nPattern or LayerName [<Pattern>]: ")) (setq key "Pattern"))
   (setq s (ssget '((0 . "hatch"))))
   )
   (progn (setq s
          (mapcar
          '(lambda (x)
             (cons (if (= "Pattern" key)
                     (vla-get-patternname x)
                     (vla-get-layer x)
                     )
                     (if (vl-catch-all-error-p (setq a (vl-catch-all-apply 'vla-get-area (list x))))
                     0.0
                     a
                     )
             )
             )
          (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))))
          )
   )
   (foreach h s
   (if (setq b (assoc (car h) out))
       (setq out (subst (cons (car b) (+ (cdr b) (cdr h))) b out))
       (setq out (cons h out))
   )
   )
   (print (_writefile
          (strcat (getvar 'dwgprefix)
                  (vl-filename-base (getvar 'dwgname))
                  "_Hatch_"
                  key
                  "_Areas.csv"
          )
          (mapcar '(lambda (x) (strcat (car x) "," (vl-princ-to-string (cdr x)))) out)
          )
   )
   (if (setq b (vl-remove-if-not '(lambda (x) (= 0 (cdr x))) out))
   (alert (strcat (itoa (length b)) " hatches have no area property!"))
   )
   )
)
(princ)
)
(vl-load-com)

Baber62 发表于 2022-7-5 16:10:06

感谢ronjonp，它可以很好地处理这个模式，但是，我似乎无法选择层名称，尝试输入层名称本身，但它不起作用。此外，例程对整个图形执行此操作，还需要它覆盖一个选择集。

ronjonp 发表于 2022-7-5 16:24:49

 
更改：
(setq s (ssget "_X" '((0 . "hatch"))))
收件人：
(setq s (ssget '((0 . "hatch"))))
 
编写代码的方式是按图层名称或填充图案名称对图案填充进行计数。没有内置过滤器。
 
我还在上面添加了一个关于没有面积属性的图案填充的警报：
           (if (setq b (vl-remove-if-not '(lambda (x) (= 0 (cdr x))) out))
   (alert (strcat (itoa (length b)) " hatches have no area property!"))
   )

Baber62 发表于 2022-7-5 16:33:41

嗨，ronjonp，很抱歉，我没能早点给你回复，代码仍然无法按层获取输出，你知道我哪里出错了吗？

Baber62 发表于 2022-7-5 16:41:58

这是我想要的结果
hatchareas图案。csv
hatchareas layername。csv

ronjonp 发表于 2022-7-5 16:49:04

您正在寻找的模式的输出甚至不接近您的初始请求？他们层输出（我猜每层的总数）应该是好的，除了它不创建标题。
 
图案比例颜色区域
Ar Con 10红色20
Ar Con 50红色30
Ar Con 50蓝色45

Baber62 发表于 2022-7-5 16:55:06

谢谢你的帮助ronjonp

查看完整版本: 按层或图案填充区域