[编程交流] 图像分离

(defun c:imgdet (/ im_dict im_ent im_lst wiz_cnt)
   (vl-load-com)
   (setq im_dict (dictsearch (namedobjdict) "ACAD_IMAGE_DICT"))
   (setq wiz_cnt -1)
   (setq im_lst '())
   (while
       (setq im_ent
                (nth
                    (setq wiz_cnt (1+ wiz_cnt))
                    im_dict
                ) ;_ {nth
       ) ;_ {setq
          (if (eq (car im_ent) 3)
              (setq im_lst
                       (cons
                           (cons
                               (cdr im_ent)
                               (cdr
                                   (nth
                                       (setq wiz_cnt (+ wiz_cnt 1))
                                       im_dict
                                   ) ;_ {nth
                               ) ;_ {cdr
                           ) ;_ {cons
                           im_lst
                       ) ;_ {cons
              ) ;_ {setq
          ) ;_ {if
   ) ;_ end_while
   (mapcar
       (function
           (lambda (x)
               (if (zerop (cdr (assoc 280 (entget (cdr x)))))
                   (vla-delete (vlax-ename->vla-object (cdr x)))
               ) ;_ {if
           ) ;_ {lamda
       ) ;_ {function
       im_lst
   ) ;_ {mapcar
   (princ)
) ;_ {defun

;|***********************---wiz24MAR09---**************************
lisproutine for detaching not_found/unreferenced/orphaned/unloaded
images,not yet tested on nested images|;
(defun c:imgdet (/
                imgpath_lst
                img_dep
                img_info
                img_info340
                img_path
                img_set
                im_dict
                im_ent
                im_ent_1
                im_lst
                im_lst_1
                wiz_cnt
               )
   (vl-load-com)
;;;------------------------------------------------------------
   ;;List all images which are present in the drawing in var = im_lst_1
   (setq img_set (ssget "_x" '((0 . "IMAGE"))))
   (setq i (sslength img_set))
   (while (not (minusp (setq i (1- i))))
       (setq im_ent_1 (ssname img_set i))
       (setq img_info (entget im_ent_1))
       (setq img_info340 (entget (cdr (assoc 340 img_info))))
       (setq img_path (cdr (assoc 1 img_info340)))
       (if (not (member img_path im_lst_1))
           (setq im_lst_1 (cons img_path im_lst_1))
       ) ;_ {if
   ) ;_ {while
;;;------------------------------------------------------------  
   ;;List all images saved in the file_dependencies in var = imgpath_lst
   (setq imgpath_lst '())
   (vlax-for
            i
             (setq img_dep
                      (vla-get-FileDependencies
                          (vla-get-ActiveDocument
                              (vlax-get-Acad-Object)
                          ) ;_ {vla-get-ActiveDocument
                      ) ;_ {vla-get-FileDependencies
             ) ;_ {vla-get-FileDependencies
       (if (= (vla-get-Feature i) "Acad:Image")
           (setq imgpath_lst
                    (cons
                        (vl-catch-all-apply
                            (function
                                (lambda ()
                                    (vla-get-FullFileName i)
                                ) ;_ {lambda
                            ) ;_ {function
                        ) ;_ {VL-CATCH-ALL-APPLY
                        imgpath_lst
                    ) ;_ {cons
           ) ;_ {setq
       ) ;_ {if
   ) ;_ {vlax-for
                   ;(vlax-release-object img_dep)
;;;------------------------------------------------------------  
   ;;List all images saved in the image_dictionary in var im_lst
   (setq im_dict (dictsearch (namedobjdict) "ACAD_IMAGE_DICT"))
   (setq wiz_cnt -1)
   (setq im_lst '())
   (while
       (setq im_ent
                (nth
                    (setq wiz_cnt (1+ wiz_cnt))
                    im_dict
                ) ;_ {nth
       ) ;_ {setq
          (if (eq (car im_ent) 3)
              (setq im_lst ;_Image list to process below
                       (cons
                           (cons
                               (cdr im_ent)
                               (cdr
                                   (nth
                                       (setq wiz_cnt (+ wiz_cnt 1))
                                       im_dict
                                   ) ;_ {nth
                               ) ;_ {cdr
                           ) ;_ {cons
                           im_lst
                       ) ;_ {cons
              ) ;_ {setq
          ) ;_ {if
   ) ;_ end_while
;;;------------------------------------------------------------  
   ;;Begin Process
   ;;Check if im_lst is present in im_lst_1 and imgpath_lst
   ;;
   (mapcar
       (function
           (lambda (x)
               (if
                   (or
                       ;;If im_lst is not member of im_lst_1
                       ;;then it is orphaned/unreferenced
                       (not (member (cdr (assoc 1 (entget (cdr x)))) im_lst_1))
                       ;;if im_list is not member of imgpath_lst
                       ;;then it is not found
                       (not (member (cdr (assoc 1 (entget (cdr x))))
                                    imgpath_lst
                            ) ;_ {member
                       ) ;_ {not
                       ;;if assoc 280 is 0 then it is unloaded
                       (zerop (cdr (assoc 280 (entget (cdr x)))))
                   ) ;_ {or
                      (vl-catch-all-apply
                          (function
                              (lambda ()
                                  (vla-delete (vlax-ename->vla-object (cdr x)))
                              ) ;_ {lambda
                          ) ;_ {function
                      ) ;_ {vl-catch-all-apply
               ) ;_ {if
           ) ;_ {lamda
       ) ;_ {function
       im_lst
   ) ;_ {mapcar
   (princ)
) ;_ {defun