【批量】处理DWG，核查含有填充面积为0的图列表

newer

1. (defun c:XDTB_BATChkHatch ( / blk doc dwg dwglst i lay layouts o tf x)
   
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:XDTB_BATChkHatch ( / blk doc dwg dwglst i lay layouts o tf x)<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 />

hasky

感谢分享啦。

yangjian001

核查含有填充面积为0

yuren008

不错的插件，谢谢分享。

kiwiairui