选择的填充按图层或者模式统计面积并生成CSV报表文件

Lisphk · 发表于 2018-12-5 22:50:12

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

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

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

zhengfang31 · 发表于 2018-12-6 08:25:46

多谢分享，学习学习

kqqt6236 · 发表于 2018-12-6 08:30:34

要是能生成EXCEL就更好了。

Dahoutian · 发表于 2018-12-6 11:07:49

看不懂不明白

newer · 发表于 2018-12-6 11:13:07

kqqt6236 发表于 2018-12-6 08:30
要是能生成EXCEL就更好了。

EXCEL可以打开CSV文件

大大asda · 发表于 2022-4-26 16:53:33

cccccccccccccccccccccccc

xdcad9819 · 发表于 2022-6-17 18:33:08

顶顶顶顶呱呱呱

账号		自动登录	找回密码
密码			立即注册

[每日一码] 选择的填充按图层或者模式统计面积并生成CSV报表文件

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。