Как автоматизировать отсоединение ненайденых IMAGE и XREF ?

kserg · 24.06.2009, 10:54

По аналогии темы "Как автоматизировать отсоединение неиспользуемых IMAGE" понадобилось средство по очистке чертежей и от ненайденых IMAGES и XREF.
Если можно, сделайте пожалуйста.
Спасибо.

kserg · 25.06.2009, 19:32

Судя по ответам, надо полагать, никак.
Не удивительно, ведь и вручную это (чаще) не получается.

VVA · 25.06.2009, 22:23

kserg, В принципе можно, но есть нюансы:
- vla-detach не детачит вложенные внешние ссылки
- по поводу вложенных изображений (растры во внешних ссылках) тоже требует проверки.
Редакция 09.07.2009

Код:

[Выделить все]

(defun C:DUXI (/ *error* xrefcnt imgcnt file tmpObj retxref retimg pat)
;;; Delete Unfound Xref and Image
;;; posted VVA http://forum.dwg.ru/showthread.php?t=36574
  (vl-load-com)
  (defun *error* (msg)
    (princ msg)
    (mip:layer-status-restore)
    (princ)
  ) ;_ end of defun
  (defun mip:layer-status-restore ()
    (foreach item *MIP_LAYER_LST*
      (if (not (vlax-erased-p (car item)))
        (vl-catch-all-apply
          '(lambda ()
             (vla-put-lock
               (car item)
               (cdr (assoc "lock" (cdr item)))
             ) ;_ end of vla-put-lock
             (vla-put-freeze
               (car item)
               (cdr (assoc "freeze" (cdr item)))
             ) ;_ end of vla-put-freeze
           ) ;_ end of lambda 
        ) ;_ end of vl-catch-all-apply 
      ) ;_ end of if 
    ) ;_ end of foreach
    (setq *MIP_LAYER_LST* nil)
  ) ;_ end of defun 

  (defun mip:layer-status-save ()
    (setq *MIP_LAYER_LST* nil)
    (vlax-for item
                   (vla-get-layers
                     (vla-get-activedocument (vlax-get-acad-object))
                   ) ;_ end of vla-get-layers
      (setq *MIP_LAYER_LST*
             (cons (list item
                         (cons "freeze" (vla-get-freeze item))
                         (cons "lock" (vla-get-lock item))
                   ) ;_ end of cons 
                   *MIP_LAYER_LST*
             ) ;_ end of cons 
      ) ;_ end of setq 
      (vla-put-lock item :vlax-false)
      (if (= (vla-get-freeze item) :vlax-true)
        (vl-catch-all-apply
          '(lambda () (vla-put-freeze item :vlax-false))
        ) ;_ end of vl-catch-all-apply
      ) ;_ end of if
    ) ;_ end of vlax-for
  ) ;_ end of defun 

  (defun DetachImage (ImgName)
    (vl-catch-all-apply
      '(lambda ()
         (vla-delete
           (vla-item
             (vla-item
               (vla-get-dictionaries
                 (vla-get-activedocument (vlax-get-acad-object))
               ) ;_ end of vla-get-dictionaries
               "ACAD_IMAGE_DICT"
             ) ;_ end of vla-Item
             ImgName
           ) ;_ end of vla-Item
         ) ;_ end of vla-Delete
       ) ;_ end of lambda
    ) ;_ end of vl-catch-all-apply
  ) ;_ end of defun
  (setq xrefcnt 0
        imgcnt 0
  ) ;_ end of setq
  (initget "Image Xref Both")
  (setq file (getkword "Delete unfound [Image/Xref/Both] <both>: "))
  (cond ((= file "Image")
         (setq pat '("AcDbRasterImage"))
         )
        ((= file "Xref")
         (setq pat '("AcDbBlockReference"))
         )
        (t (setq pat '("AcDbRasterImage" "AcDbBlockReference")))
        )
  (mip:layer-status-save)
  (vlax-for lay (vla-get-layouts
                  (vla-get-activedocument (vlax-get-acad-object))
                ) ;_ end of vla-get-Layouts
    (vlax-for item (vla-get-block lay)
      (cond
        ((and
           (member (vla-get-objectname item) pat)
           (eq (vla-get-objectname item) "AcDbBlockReference")
           (vlax-property-available-p item 'Path)
           (setq file (vla-get-path item))
           (setq tmpObj
                  (vla-item
                    (vla-get-blocks
                      (vla-get-activedocument (vlax-get-acad-object))
                    ) ;_ end of vla-get-Blocks
                    (vla-get-name item)
                  ) ;_ end of vla-Item
           ) ;_ end of setq
         ) ;_ end of and
         (if
           (not (or (findfile file)
                    (findfile (strcat (vl-filename-base file)
                                      (vl-filename-extension file)
                              ) ;_ end of strcat
                    ) ;_ end of findfile
                ) ;_ end of or
           ) ;_ end of not
            (if
              (not (vl-catch-all-error-p
                     (vl-catch-all-apply 'vla-detach (list tmpObj))
                   ) ;_ end of VL-CATCH-ALL-ERROR-P
              ) ;_ end of not
               (setq xrefcnt (1+ xrefcnt))
            ) ;_ end of if
         ) ;_ end of if
        )
        ((and
           (member (vla-get-objectname item) pat)
           (eq (vla-get-objectname item) "AcDbRasterImage")
           (setq file (vla-get-imagefile item))
         ) ;_ end of and
         (if
           (not (or (findfile file)
                    (findfile (strcat (vl-filename-base file)
                                      (vl-filename-extension file)
                              ) ;_ end of strcat
                    ) ;_ end of findfile
                ) ;_ end of or
           ) ;_ end of not
           (progn
             (if (not (member (vla-get-name item) retimg))
             (setq retimg (cons (vla-get-name item) retimg)))
            (vl-catch-all-apply 'vla-delete (list item))
           (setq imgcnt (1+ imgcnt))
           )
         ) ;_ end of if
        )
        (t nil)
      ) ;_ end of cond
    ) ;_ end of vlax-for
  ) ;_ end of vlax-for
  
(mapcar '(lambda (x)
            (vl-catch-all-apply
                        'DetachImage
                        (list x)
                      ) ;_ end of vl-catch-all-apply
         ) ;_ end of lambda
        retimg
) ;_ end of mapcar
 (mip:layer-status-restore)
  (princ "\nDelete Unfound Image\t")
  (princ imgcnt)
  (princ "\nDetach Unfound Xref\t")
  (princ xrefcnt)
  (princ)
)

kserg · 26.06.2009, 09:26

Большое спасибо, буду пробовать.

.........
Протестировал на IMAGE.
К сожалению, удаляет из чертежа абсолютно ВСЕ картинки: и найденые, и ненайденые.
AutoCAD2005rus. Вставлено несколько картинок с режимами сохранения к ним путей: "без пути", "относительный" и "полный".

Запустил 1-ый раз DUXI. Были удалены (только) НЕНАЙДЕНЫЕ картинки "без пути".
Тут же запустил 2 раз DUXI. Были удалены (только) НЕНАЙДЕНЫЕ картинки "относительный".
---//--- запустил 3 раз DUXI. Были удалены (только) НЕНАЙДЕНЫЕ картинки "полный".
---//--- запустил 4 раз DUXI. Были удалены И ВСЕ НАЙДЕНЫЕ картинки ("полный" и "относительный").

В AutoCAD2006eng и AutoCAD2007rus - аналогичная ситуация.

VVA · 26.06.2009, 11:15

kserg, Код исправил, обновил #3. В любом случае модификация только после 4 июля (отпуск).

kserg · 26.06.2009, 11:51

Спасибо. Протестировал обновление кода на IMAGE.

Результат - в лучшую сторону, т.к. теперь найденые картинки НЕ УДАЛЯЕТ.
Однако в остальном - по-прежнему, т.е. 1-ым запуском удаляются (только) НЕНАЙДЕНЫЕ картинки "без пути" и т.д.

С нетерпением будем ждать 5 июля.
Прекрасного Вам отдыха и хорошей погоды (кажется, обещают, что в Минске с ближайших выходных она очень даже наладится)...

kserg · 08.07.2009, 12:40

Попробовал еще раз команду DUXI - удаляет только по 1 ненайденому растру за 1 запуск команды...

VVA · 08.07.2009, 13:24

kserg, Пришли по почте или выложи файл для тестирования

kserg · 08.07.2009, 13:49

Это не чертеж объекта, а именно "для тестирования":

VVA · 08.07.2009, 15:23

Обновил #3

kserg · 08.07.2009, 17:10

Спасибо, теперь все корректно работает.
Последняя просьба (извините, пожалуйста, за нахальство):
расчленить 1 команду на 2, отдельно для растров и отдельно для ссылок.

Попробовал сам:

Код:

[Выделить все]

;;; Delete Unfount Xref and Image
(vl-load-com)
(defun mip:layer-status-restore ()
  (foreach item *MIP_LAYER_LST*
    (if (not (vlax-erased-p (car item)))
      (vl-catch-all-apply
        '(lambda ()
           (vla-put-lock
             (car item)
             (cdr (assoc "lock" (cdr item)))
           ) ;_ end of vla-put-lock
           (vla-put-freeze
             (car item)
             (cdr (assoc "freeze" (cdr item)))
           ) ;_ end of vla-put-freeze
         ) ;_ end of lambda 
      ) ;_ end of vl-catch-all-apply 
    ) ;_ end of if 
  ) ;_ end of foreach
  (setq *MIP_LAYER_LST* nil)
) ;_ end of defun 
(defun mip:layer-status-save ()
  (setq *MIP_LAYER_LST* nil)
  (vlax-for item
                 (vla-get-layers
                   (vla-get-activedocument (vlax-get-acad-object))
                 ) ;_ end of vla-get-layers
    (setq *MIP_LAYER_LST*
           (cons (list item
                       (cons "freeze" (vla-get-freeze item))
                       (cons "lock" (vla-get-lock item))
                 ) ;_ end of cons 
                 *MIP_LAYER_LST*
           ) ;_ end of cons 
    ) ;_ end of setq 
    (vla-put-lock item :vlax-false)
    (if (= (vla-get-freeze item) :vlax-true)
      (vl-catch-all-apply
        '(lambda () (vla-put-freeze item :vlax-false))
      ) ;_ end of vl-catch-all-apply
    ) ;_ end of if
  ) ;_ end of vlax-for
) ;_ end of defun 

;;; Delete Unfound Image
(defun C:DUIMG (/ *error* imgcnt file retimg)
  (defun *error* (msg)
    (princ msg)
    (mip:layer-status-restore)
    (princ)
  ) ;_ end of defun

  (defun DetachImage (ImgName)
    (vl-catch-all-apply
      '(lambda ()
         (vla-delete
           (vla-item
             (vla-item
               (vla-get-dictionaries
                 (vla-get-activedocument (vlax-get-acad-object))
               ) ;_ end of vla-get-dictionaries
               "ACAD_IMAGE_DICT"
             ) ;_ end of vla-Item
             ImgName
           ) ;_ end of vla-Item
         ) ;_ end of vla-Delete
       ) ;_ end of lambda
    ) ;_ end of vl-catch-all-apply
  ) ;_ end of defun
  (setq imgcnt 0
  ) ;_ end of setq
  (mip:layer-status-save)
  (vlax-for lay (vla-get-layouts
                  (vla-get-activedocument (vlax-get-acad-object))
                ) ;_ end of vla-get-Layouts
    (vlax-for item (vla-get-block lay)
      (cond
        ((and
           (eq (vla-get-objectname item) "AcDbRasterImage")
           (setq file (vla-get-imagefile item))
         ) ;_ end of and
         (if
           (not (or (findfile file)
                    (findfile (strcat (vl-filename-base file)
                                      (vl-filename-extension file)
                              ) ;_ end of strcat
                    ) ;_ end of findfile
                ) ;_ end of or
           ) ;_ end of not
           (progn
             (if (not (member (vla-get-name item) retimg))
             (setq retimg (cons (vla-get-name item) retimg)))
            (vl-catch-all-apply 'vla-delete (list item))
           (setq imgcnt (1+ imgcnt))
           )
         ) ;_ end of if
        )
        (t nil)
      ) ;_ end of cond
    ) ;_ end of vlax-for
  ) ;_ end of vlax-for
  (mapcar '(lambda (x)
              (vl-catch-all-apply
                          'DetachImage
                          (list x)
                        ) ;_ end of vl-catch-all-apply
           ) ;_ end of lambda
          retimg
  ) ;_ end of mapcar
  (mip:layer-status-restore)
  (princ "\nDelete Unfound Image\t")
  (princ imgcnt)
  (princ)
) ;_ end of defun

;;; Delete Unfound Xref
(defun C:DUXRF (/ *error* xrefcnt file tmpObj)
  (defun *error* (msg)
    (princ msg)
    (mip:layer-status-restore)
    (princ)
  ) ;_ end of defun
  (setq xrefcnt 0
  ) ;_ end of setq
  (mip:layer-status-save)
  (vlax-for lay (vla-get-layouts
                  (vla-get-activedocument (vlax-get-acad-object))
                ) ;_ end of vla-get-Layouts
    (vlax-for item (vla-get-block lay)
      (cond
        ((and
           (eq (vla-get-objectname item) "AcDbBlockReference")
           (vlax-property-available-p item 'Path)
           (setq file (vla-get-path item))
           (setq tmpObj
                  (vla-item
                    (vla-get-blocks
                      (vla-get-activedocument (vlax-get-acad-object))
                    ) ;_ end of vla-get-Blocks
                    (vla-get-name item)
                  ) ;_ end of vla-Item
           ) ;_ end of setq
         ) ;_ end of and
         (if
           (not (or (findfile file)
                    (findfile (strcat (vl-filename-base file)
                                      (vl-filename-extension file)
                              ) ;_ end of strcat
                    ) ;_ end of findfile
                ) ;_ end of or
           ) ;_ end of not
            (if
              (not (vl-catch-all-error-p
                     (vl-catch-all-apply 'vla-detach (list tmpObj))
                   ) ;_ end of VL-CATCH-ALL-ERROR-P
              ) ;_ end of not
               (setq xrefcnt (1+ xrefcnt))
            ) ;_ end of if
         ) ;_ end of if
        )
        (t nil)
      ) ;_ end of cond
    ) ;_ end of vlax-for
  ) ;_ end of vlax-for
  (mip:layer-status-restore)
  (princ "\nDetach Unfound Xref\t")
  (princ xrefcnt)
  (princ)
) ;_ end of defun

VVA · 09.07.2009, 17:14

kserg, молодца.
Я тоже обновил #3. Там одна команда, что удалять запрашивается опциями.

kserg · 09.07.2009, 20:39

Спасибо, нашел.

kserg · 17.07.2009, 10:31

Есть еще один моментик.

Здесь пользователю предлагается "Delete unfound [Image/Xref/Both] <both>: ". Но он, пользователь, и не подозревает, что, возможно, таковые в чертеже - отсутствуют, т.е нечего и удалять.

В коде формируется список retimg (в прежнем варианте их было 2: retimg и retxref), но, по моему убогому разумению, формируется одновременно с удалением, уже в процессе выполнения...

Можно ли заранее, с целью так сказать еще большего облагораживания, перед запросом "Delete unfound [Image/Xref/Both] <both>: ", если не сформировать оба списка, то хотя бы узнать количество их элементов, или даже их существование (наличие, что ли) в чертеже, дабы запрос "Delete unfound [Image/Xref/Both] <both>: " имел право на жизнь.
Чтобы получилось что-то типа, (извиняюсь за мой плохой английский)
"В чертеже обнаружено 2 ненайденых растра и 3 ненайденых ссылки".
"Delete unfound [Image/Xref/Both] <both>: "

VVA · 17.07.2009, 12:37

kserg, Логично. Новый вариант

Код:

[Выделить все]

(defun C:DUXI (/ *error* file tmpObj retxref retimg retimgobj pat)
;;; Delete Unfound Xref and Image
;;; posted VVA http://forum.dwg.ru/showthread.php?t=36574
  (vl-load-com)
  (defun *error* (msg)
    (princ msg)
    (mip:layer-status-restore)
    (princ)
  ) ;_ end of defun
  (defun mip:layer-status-restore ()
    (foreach item *MIP_LAYER_LST*
      (if (not (vlax-erased-p (car item)))
        (vl-catch-all-apply
          '(lambda ()
             (vla-put-lock
               (car item)
               (cdr (assoc "lock" (cdr item)))
             ) ;_ end of vla-put-lock
             (vla-put-freeze
               (car item)
               (cdr (assoc "freeze" (cdr item)))
             ) ;_ end of vla-put-freeze
           ) ;_ end of lambda 
        ) ;_ end of vl-catch-all-apply 
      ) ;_ end of if 
    ) ;_ end of foreach
    (setq *MIP_LAYER_LST* nil)
  ) ;_ end of defun 

  (defun mip:layer-status-save ()
    (setq *MIP_LAYER_LST* nil)
    (vlax-for item
                   (vla-get-layers
                     (vla-get-activedocument (vlax-get-acad-object))
                   ) ;_ end of vla-get-layers
      (setq *MIP_LAYER_LST*
             (cons (list item
                         (cons "freeze" (vla-get-freeze item))
                         (cons "lock" (vla-get-lock item))
                   ) ;_ end of cons 
                   *MIP_LAYER_LST*
             ) ;_ end of cons 
      ) ;_ end of setq 
      (vla-put-lock item :vlax-false)
      (if (= (vla-get-freeze item) :vlax-true)
        (vl-catch-all-apply
          '(lambda () (vla-put-freeze item :vlax-false))
        ) ;_ end of vl-catch-all-apply
      ) ;_ end of if
    ) ;_ end of vlax-for
  ) ;_ end of defun 

  (defun DetachImage (ImgName)
    (vl-catch-all-apply
      '(lambda ()
         (vla-delete
           (vla-item
             (vla-item
               (vla-get-dictionaries
                 (vla-get-activedocument (vlax-get-acad-object))
               ) ;_ end of vla-get-dictionaries
               "ACAD_IMAGE_DICT"
             ) ;_ end of vla-Item
             ImgName
           ) ;_ end of vla-Item
         ) ;_ end of vla-Delete
       ) ;_ end of lambda
    ) ;_ end of vl-catch-all-apply
  ) ;_ end of defun
  (setq pat '("AcDbRasterImage" "AcDbBlockReference"))
  (vlax-for lay (vla-get-layouts
                  (vla-get-activedocument (vlax-get-acad-object))
                ) ;_ end of vla-get-Layouts
    (princ "\nWait... the search for rasters and xrefs in ")(princ (vla-get-name lay))
    (vlax-for item (vla-get-block lay)
      (cond
        ((and
           (member (vla-get-objectname item) pat)
           (eq (vla-get-objectname item) "AcDbBlockReference")
           (vlax-property-available-p item 'Path)
           (setq file (vla-get-path item))
           (setq tmpObj
                  (vla-item
                    (vla-get-blocks
                      (vla-get-activedocument (vlax-get-acad-object))
                    ) ;_ end of vla-get-Blocks
                    (vla-get-name item)
                  ) ;_ end of vla-Item
           ) ;_ end of setq
         ) ;_ end of and
         (if
           (not (or (findfile file)
                    (findfile (strcat (vl-filename-base file)
                                      (vl-filename-extension file)
                              ) ;_ end of strcat
                    ) ;_ end of findfile
                ) ;_ end of or
           ) ;_ end of not
           (setq retxref (cons tmpobj retxref))
         ) ;_ end of if
        )
        ((and
           (member (vla-get-objectname item) pat)
           (eq (vla-get-objectname item) "AcDbRasterImage")
           (setq file (vla-get-imagefile item))
         ) ;_ end of and
         (if
           (not (or (findfile file)
                    (findfile (strcat (vl-filename-base file)
                                      (vl-filename-extension file)
                              ) ;_ end of strcat
                    ) ;_ end of findfile
                ) ;_ end of or
           ) ;_ end of not
           (progn
             (if (not (member (vla-get-name item) retimg))
             (setq retimg (cons (vla-get-name item) retimg)))
             (setq retimgobj (cons item retimgobj))
           )
         ) ;_ end of if
        )
        (t nil)
      ) ;_ end of cond
    ) ;_ end of vlax-for
    (princ " ...OK")
  ) ;_ end of vlax-for
  (princ "\nTotal: ")
  (princ (length retimg))(princ " unfound rasters and ")
  (princ (length retxref))(princ " unfound xrefs ")
  (if (or retimg retxref)
    (progn
  (initget "Image Xref Both")
  (setq file (getkword "Delete unfound [Image/Xref/Both] <both>: "))
  (cond ((= file "Image")
         (setq pat '("AcDbRasterImage"))
         )
        ((= file "Xref")
         (setq pat '("AcDbBlockReference"))
         )
        (t (setq pat '("AcDbRasterImage" "AcDbBlockReference")))
        )
  (mip:layer-status-save)
  (if (member "AcDbRasterImage" pat)
    (progn
      (mapcar '(lambda(x)
                 (vl-catch-all-apply 'vla-delete (list x))
                 )
              retimgobj
              )
       (mapcar '(lambda(x)
                 (vl-catch-all-apply 'DetachImage (list x))
                 )
              retimg
              )
      )
    )
   (if (member "AcDbBlockReference" pat)
    (progn
       (mapcar '(lambda(x)
                  (vl-catch-all-apply 'vla-detach (list x))
                  )
               retxref
               )
      )
    ) 
 (mip:layer-status-restore)
  )
    )
  (princ)
)

kserg · 17.07.2009, 14:17

Спасибо. Теперь стало еще удобнее и информативнее.

VVA · 21.07.2009, 10:16

Объединенные команды удаления неиспользуемых растров и ненайденных растров и вн. ссылок здесь: Как автоматизировать отсоединение неиспользуемых IMAGE?

kserg · 07.09.2009, 15:49

Может стоит добавить в поисках в "список" or:

Код:

[Выделить все]

(if
           (not (or (findfile file)
                    (findfile (strcat (vl-filename-base file)
                                      (vl-filename-extension file)
                              ) ;_ end of strcat
                    ) ;_ end of findfile
                ) ;_ end of or
           ) ;_ end of not
           (progn .............

такое:

Код:

[Выделить все]

(findfile (strcat (vla-get-name item) (vl-filename-extension file)))

,- в смысле - из расчета на "дурака", если вздумает переименовать растр (не файл растра!) в чертеже ?
Приходилось сталкиваться с такими чертежами, где имя растра не совпадает с именем его файла (команда удаления ненайденых растров удаляеет и их, хотя они есть и имеют статус "Загружено")...

24.06.2009, 10:54		#1
Как автоматизировать отсоединение ненайденых IMAGE и XREF ? kserg Регистрация: 22.04.2004 Сообщений: 269 По аналогии темы "Как автоматизировать отсоединение неиспользуемых IMAGE" понадобилось средство по очистке чертежей и от ненайденых IMAGES и XREF. Если можно, сделайте пожалуйста. Спасибо. Последний раз редактировалось kserg, 24.06.2009 в 19:09.
Просмотров: 5869

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Кто как работает с XREF?	Mikhail	AutoCAD	20	19.03.2018 18:05
Мониторы LCD CRT		Разное	94	17.06.2008 10:51
Как удалить Xref ?	Новицкий	AutoCAD	15	10.03.2005 09:24
Как запретить редактирование XREF?	Mikhail	AutoCAD	6	15.11.2004 17:10