批量搜索DWG，列出图中填充面积异常的文件

marting

填充异常，就是填充面积为0的。图中有填充面积为0的，不好发现，统计工程量时候就出问题了。
下面代码，不需要打开DWG，批量搜索指定目录的DWG文件，找到后，文本屏幕打印出来文件名。


需要加载  晓东通用LISP函数库。或到开源函数库论坛找需要函数的代码。
xd::vla:catchapply
xd::vla:odbx

1. (defun c:tt ()
   
2.   (defun _find (doc)
   
3.     (textpage)
   
4.     (setq dwglst nil)
   
5.     (princ (strcat "\n搜索 " (setq dwg (vla-get-name doc))))
   
6.     (setq layouts (vla-get-layouts doc))
   
7.     (setq dwglst nil)
   
8.     (vlax-for lay layouts
   
9.       (setq blk (vla-get-block lay))
   
10.       (setq tf t
    
11.             i  -1
    
12.       )
    
13.       (while
    
14.         (and tf
    
15.              (setq
    
16.                o (xd::vla:catchapply vla-item (list blk (setq i (1+ i))))
    
17.              )
    
18.         )
    
19.          (if (and (= (vla-get-objectname o) "AcDbHatch")
    
20.                   (not (xd::vla:catchapply vla-get-area (list o)))
    
21.              )
    
22.            (progn (setq tf nil)
    
23.                   (setq dwglst (cons (vla-get-name doc) dwglst))
    
24.            )
    
25.          )
    
26.       )
    
27.     )
    
28.     (if dwglst
    
29.       (progn (princ "\n\n**********************\n发现异常填充，请核查.\n")
    
30.              (mapcar '(lambda (x) (princ "\n") (princ x)) dwglst)
    
31.       )
    
32.     )
    
33.   )
    
34.   (xd::vla:odbx '_find nil nil)
    
35.   (princ)
    
36. )
    

(defun c:tt ()<br />   (defun _find (doc)<br />     (textpage)<br />     (setq dwglst nil)<br />     (princ (strcat "\n搜索 " (setq dwg (vla-get-name doc))))<br />     (setq layouts (vla-get-layouts doc))<br />     (setq dwglst nil)<br />     (vlax-for lay layouts<br />       (setq blk (vla-get-block lay))<br />       (setq tf t<br />             i  -1<br />       )<br />       (while<br />         (and tf<br />              (setq<br />                o (xd::vla:catchapply vla-item (list blk (setq i (1+ i))))<br />              )<br />         )<br />          (if (and (= (vla-get-objectname o) "AcDbHatch")<br />                   (not (xd::vla:catchapply vla-get-area (list o)))<br />              )<br />            (progn (setq tf nil)<br />                   (setq dwglst (cons (vla-get-name doc) dwglst))<br />            )<br />          )<br />       )<br />     )<br />     (if dwglst<br />       (progn (princ "\n\n**********************\n发现异常填充，请核查.\n")<br />              (mapcar '(lambda (x) (princ "\n") (princ x)) dwglst)<br />       )<br />     )<br />   )<br />   (xd::vla:odbx '_find nil nil)<br />   (princ)<br /> )<br />

Lisphk

那发现了0面积填充，怎么办？能算出来吗？

newer

Lisphk 发表于 2017-12-22 12:16

晓东工具箱里面算面积的工具，都能算异常填充的面积

下面是简短算填充面积的代码

1. (defun c:tt ()
   
2.   (if (and (xdrx_initssget "选择计算的填充<退出>")
   
3.            (setq ss (xdrx_ssget '((0 . "HATCH"))))
   
4.       )
   
5.     (progn (setq ar  (xdrx_entity_getproperty ss "area")
   
6.                  ar  (apply '+ ar)
   
7.            )
   
8.            (xdrx_prompt "\n填充总面积为:" (rtos ar 2 1))
   
9.     )
   
10.   )
    
11.   (princ)
    
12. )
    

(defun c:tt ()<br />   (if (and (xdrx_initssget "选择计算的填充<退出>")<br />            (setq ss (xdrx_ssget '((0 . "HATCH"))))<br />       )<br />     (progn (setq ar  (xdrx_entity_getproperty ss "area")<br />                  ar  (apply '+ ar)<br />            )<br />            (xdrx_prompt "\n填充总面积为:" (rtos ar 2 1))<br />     )<br />   )<br />   (princ)<br /> )<br />