删除图中所有图像

newer

1. (defun RemoveAllRaster (doc / _catchapply dict lockd)
   
2.   (vl-load-com)
   
3.   (defun _catchapply (method params / result)
   
4.     (if        (not (vl-catch-all-error-p
   
5.                (setq result (vl-catch-all-apply method params))
   
6.              )
   
7.         )
   
8.       result
   
9.     )
   
10.   )
    
11.   (vlax-for layer (vla-get-layers doc)
    
12.     (if        (eq :vlax-true (vla-get-lock layer))
    
13.       (vla-put-lock
    
14.         (car (setq lockd (cons layer lockd)))
    
15.         :vlax-false
    
16.       )
    
17.     )
    
18.   )
    
19.   (vlax-for block (vla-get-blocks doc)
    
20.     (vlax-for object block
    
21.       (if (member (vla-get-objectname object)
    
22.                   '("AcDbOle2Frame" "AcDbRasterImage")
    
23.           )
    
24.         (_catchapply 'vla-delete (list object))
    
25.       )
    
26.     )
    
27.   )
    
28.   (if (setq dict (_catchapply
    
29.                    'vla-item
    
30.                    (list (vla-get-dictionaries doc) "ACAD_IMAGE_DICT")
    
31.                  )
    
32.       )
    
33.     (progn (vlax-for object dict
    
34.              (_catchapply 'vla-delete (list object))
    
35.            )
    
36.            (_catchapply 'vla-delete (list dict))
    
37.     )
    
38.   )
    
39.   (if (setq dict (_catchapply
    
40.                    'vla-item
    
41.                    (list (vla-get-dictionaries doc) "ACAD_IMAGE_VARS")
    
42.                  )
    
43.       )
    
44.     (_catchapply 'vla-delete (list dict))
    
45.   )
    
46.   (foreach layer lockd (vla-put-lock layer :vlax-true))
    
47.   (vla-regen doc acallviewports)
    
48.   (princ)
    
49. )
    
50. 
    
51. (defun c:RemoveAllPics nil
    
52.   (RemoveAllRaster
    
53.     (vla-get-activedocument (vlax-get-acad-object))
    
54.   )
    
55.   (princ)
    
56. )
    
57. 
    

(defun RemoveAllRaster (doc / _catchapply dict lockd)<br />   (vl-load-com)<br />   (defun _catchapply (method params / result)<br />     (if        (not (vl-catch-all-error-p<br />                (setq result (vl-catch-all-apply method params))<br />              )<br />         )<br />       result<br />     )<br />   )<br />   (vlax-for layer (vla-get-layers doc)<br />     (if        (eq :vlax-true (vla-get-lock layer))<br />       (vla-put-lock<br />         (car (setq lockd (cons layer lockd)))<br />         :vlax-false<br />       )<br />     )<br />   )<br />   (vlax-for block (vla-get-blocks doc)<br />     (vlax-for object block<br />       (if (member (vla-get-objectname object)<br />                   '("AcDbOle2Frame" "AcDbRasterImage")<br />           )<br />         (_catchapply 'vla-delete (list object))<br />       )<br />     )<br />   )<br />   (if (setq dict (_catchapply<br />                    'vla-item<br />                    (list (vla-get-dictionaries doc) "ACAD_IMAGE_DICT")<br />                  )<br />       )<br />     (progn (vlax-for object dict<br />              (_catchapply 'vla-delete (list object))<br />            )<br />            (_catchapply 'vla-delete (list dict))<br />     )<br />   )<br />   (if (setq dict (_catchapply<br />                    'vla-item<br />                    (list (vla-get-dictionaries doc) "ACAD_IMAGE_VARS")<br />                  )<br />       )<br />     (_catchapply 'vla-delete (list dict))<br />   )<br />   (foreach layer lockd (vla-put-lock layer :vlax-true))<br />   (vla-regen doc acallviewports)<br />   (princ)<br /> )<br /> <br /> (defun c:RemoveAllPics nil<br />   (RemoveAllRaster<br />     (vla-get-activedocument (vlax-get-acad-object))<br />   )<br />   (princ)<br /> )<br /> <br />

chen7560152

版主给力~~~

xvjiex

删除图中所有图像，感谢楼主分享！