删除图中所有图像

newer · 发表于 2021-1-26 18:43:56

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

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

×

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

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

chen7560152 · 发表于 2021-1-27 14:22:23

版主给力~~~

xvjiex · 发表于 2021-2-15 07:24:49

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

hh_lj007 · 发表于 2021-8-13 14:10:26

感谢楼主分享源码！

yanshengjiang · 发表于 2021-12-9 08:36:30

楼主这是针对cass10的功能吗？

xvjiex · 发表于 2021-12-9 14:41:54

版主厉害，vl-catch-all-error-p vl-catch-all-apply 整合成函数了。收藏！

flowerson · 发表于 2022-7-29 17:01:38

不错，学习了！

ilovem · 发表于 2023-4-23 20:35:18

不错，学习了

wzs0777 · 发表于 2024-7-24 14:42:59

学习了。好东西

lxl522 · 发表于 2024-9-30 08:37:14

ole图像也可以嘛？

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

[其他] 删除图中所有图像

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