Как автоматизировать отсоединение неиспользуемых IMAGE?

kp+ · 19.12.2005, 16:06

При длительной работе с Rasterex в чертеже накапливается куча неиспользуемых (unreferenced) растровых изображений. Перед сохранением чертежа их надо отсоединять (detach), иначе Rasterex предложит сохранить каждое из них.
Ничего сложного тут нет, но если забыть это сделать, приходится отвечать "нет" на запрос сохранения каждого из этих изображений. А это уже муторно. Хотелось бы как-то объединить операции сохранения чертежа и "PURGE" этого мусора.

В общем, подскажите, PLS, как автоматизировать отсоединение неиспользуемых растровых изображений?

kp+ · 20.12.2005, 17:48

Что-то никто не откликается...
Может быть, я слишком запутанно изложил вопрос?

Тогда более конкретно: где записывается информация о растровых изображениях и об их состояниях (загружен/выгружен, не найден, не используется и т. д.)?

По ходу дела, это какой-то словарь, но какой и как до него достать - я не понял.

Подскажите, PLS!

fixo · 20.12.2005, 18:55

Цитата:

Сообщение от kp+

Что-то никто не откликается...
Может быть, я слишком запутанно изложил вопрос?

Тогда более конкретно: где записывается информация о растровых изображениях и об их состояниях (загружен/выгружен, не найден, не используется и т. д.)?

По ходу дела, это какой-то словарь, но какой и как до него достать - я не понял.

Подскажите, PLS!

Сам словарь достать несложно:

Код:

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

(dictsearch (namedobjdict) "ACAD_IMAGE_DICT")

Гораздо сложнее найти неиспользуемые IMAGE, если найдешь,
тогда остальные вхождения IMAGE_DEFINITION отсеешь от тех
что вставлены:

Код:

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

(ssget "_X" (list (cons 0 "IMAGE")))

Нет времени поворчать над такой сахарной косточкой...

~'J'~

kp+ · 21.12.2005, 10:31

Спасибо, это как раз то, что надо.
Примочка заработала.

fixo · 21.12.2005, 10:34

Цитата:

Сообщение от kp+

Спасибо, это как раз то, что надо.
Примочка заработала.

Если все получится выложи для других, может кто
тоже интересуется

~'J'~

kp+ · 23.12.2005, 10:42

Вот она, моя прога. Сделана по-простому. Не судите слишком строго.
Проверялась на ACAD2000i.

Код:

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

(defun DUI (/ im imd imd1 ims i det);Detach Unused Images

  (setq imd (dictsearch (namedobjdict) "ACAD_IMAGE_DICT")); список со словарем растров
  
  (while (assoc 3 imd);выбрасывание из списка словаря всего, кроме групп с именами растров
    (progn
      (setq im (assoc 3 imd))
      (setq imd (vl-remove im imd))        
      (setq imd1 (append imd1 (list im)))
    )
   )
  (setq imd1 (mapcar 'cdr imd1));список имен всех растров, котороые объявлены в чертеже

  (setq im (ssget "X" '((0 . "IMAGE"))));выбор всех растров, имеющих рамку в чертеже ("используемых")
  (setq ims (ssnamex im))
  (setq im nil)
  (setq ims (mapcar 'cadr ims));выкидывание номеров набора из списка
  (setq ims (mapcar 'vlax-ename->vla-object ims));преобразование во VLA-объекты
  (setq ims (mapcar 'vla-get-name ims));имена растров, имеющих рамку в чертеже (используемых)

  (setq i 0)
  (while (< i (length ims))
    (progn
      (setq imd1 (vl-remove (nth i ims) imd1));кандидаты на отсоединение
      (setq i (1+ i))
    )
  )

  (setq i 0 det "");строка для команды -image
  (while (< i (length imd1))
    (progn
      (setq det (strcat det (nth i imd1) ","))
      (setq i (1+ i))
    )
  )


  (vl-cmdf "-image" "d" det);отсоединение неиспользуемых
)

fixo · 23.12.2005, 16:28

Молодца!

~'J'~

VVA · 23.07.2007, 14:43

Удаление неиспользуемых IMAGE и XREF. Мой вариант. Удаляет растры без использования команды -image. Выяснилось, что если в имени растра есть символ #, то -image отказывается его detach'ить. :twisted:
Проверяет наличие растров не только в модели/листе, но и в описании блоков (есть любители включить растр в блок), игнорируя Xref.

Код:

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

;;;Created by VVA
;;;posted
;;;http://forums.augi.com/showthread.php?t=64428&page=2&pp=10
;;;http://forum.dwg.ru/showthread.php?p=154632#post154632
(vl-load-com)
(defun mip_MakeUniqueMembersOfList  ( lst / OutList head)
  (while lst
    (setq head (car lst)
          lst (vl-remove-if '(lambda(pt)(equal pt head 1e-6)) lst)
          OutList (append OutList (list head))))
  OutList
  )
;(getEntNameinActiveDoc '("AcDbRasterImage" "AcDbBlockReference"))
;(getEntNameinActiveDoc '("AcDbRasterImage" "AcDbBlockReference"))
(defun getEntNameinActiveDoc ( pat  / blk  Obj ret)
 (princ "\nCheck") 
 (vlax-for Blk (vla-get-Blocks (vla-get-activedocument (vlax-get-acad-object)))
   (princ (strcat "\nCheck "(vla-get-name Blk)))
   (if (= (vla-get-IsXref Blk) :vlax-false)
     (progn
   (vlax-for Obj Blk
     (if (and (vl-position (vla-get-ObjectName Obj) pat)
              (vlax-property-available-p obj 'Name)
              (or (vlax-property-available-p obj 'Path)
                  (vlax-property-available-p obj 'ImageFile)
                  )
              )
       (setq ret (cons (vla-get-Name obj) ret))
       )
     )
     (princ " ... Done")
   )
     )
   )
  (mip_MakeUniqueMembersOfList ret)
  )

(defun ImgDet (/ all_raster_image_name image_set used_raster_image_name)
    (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    
    (vl-load-com)
    (setvar "CMDECHO" 0)
    ;;list of all image
    (if
        (setq all_raster_image_name
                 (mapcar 'cdr
                         (vl-remove-if-not
                             (function (lambda (x) (= 3 (car x))))
                             (dictsearch (namedobjdict) "ACAD_IMAGE_DICT")
                         ) ;_ end of vl-remove-if-not
                 ) ;_ end of mapcar
        ) ;_ end of setq
           (setq all_raster_image_name (mapcar 'strcase all_raster_image_name))
    ) ;_ end of if
    ;;list of inserting image
  (setq used_raster_image_name (getEntNameinActiveDoc '("AcDbRasterImage")))
  (setq used_raster_image_name (mapcar 'strcase used_raster_image_name))
    (mapcar
        '(lambda (img) (setq all_raster_image_name (vl-remove img all_raster_image_name)))
        used_raster_image_name
    ) ;_ end of mapcar
    (mapcar 'DetachImage all_raster_image_name)
    (princ "\nNot used image ")
    (mapcar '(lambda (x) (princ x) (princ ", ")) all_raster_image_name)
    (if all_raster_image_name (princ " ... detach")(princ " ... missing"))
    (princ)
)
(defun XrefDet (/ all_xref used_xref used_xref_name xref_set)
 (vl-load-com)
    (vlax-for Blk (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
        (if (= (vla-get-isxref Blk) :vlax-true)
            (setq all_xref (cons blk all_xref))
        ) ;_ end of if

    ) ;_ end of vlax-for
  (setq used_xref_name (getEntNameinActiveDoc '("AcDbBlockReference")))
  (setq all_xref (vl-remove-if '(lambda (x)(vl-position (vla-get-name x) used_xref_name)) all_xref))
  (setq used_xref_name (mapcar 'vla-get-name all_xref))
    (vl-catch-all-apply
        '(lambda ()
             (mapcar 'vla-detach all_xref)
         ) ;_ end of lambda
    ) ;_ end of vl-catch-all-apply
    (princ "\nNot used xref ")
    (mapcar '(lambda (x) (princ x) (princ ", ")) used_xref_name)
    (princ " ... detach")
    (princ)
) ;_ end of defun
(defun C:ImgDet ()(ImgDet))
(defun C:XrefDet ()(XrefDet))
(princ "\nType ImgDet or XrefDet in command line")

Удаление ненайденных внешних ссылок (XREF) и изображений (IMAGE)

kserg · 22.05.2009, 18:57

Уважаемый VVA, время прошло немалое, код остался преждним ?

VVA · 23.05.2009, 20:43

А что, не работает? У меня к нему претензий пока нет.

kserg · 26.05.2009, 14:04

"А что, не работает?"

Спасибо, работает (спасает часто...). Просто хотелось узнать, может появились обновления к програмке.

kserg · 17.07.2009, 14:27

> VVA

Прошу прощения, а нельзя ли и здесь как в теме "Как автоматизировать отсоединение ненайденых IMAGE и XREF ?"
http://forum.dwg.ru/showthread.php?t=36574
был предварительный поиск неиспользуемых растров и ссылок с последующим соответствующим сообщением по результатам поиска и запросом на удаление?

VVA · 21.07.2009, 10:13

Так как они используют общие ф-ции, то объединил 2 команды. Общие ф-ции сделал глобальными
2 команды: IMGDET и DUXI

Код:

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

(defun C:IMGDET (/ *error* used_raster_image_name all_image pat)
;;; Delete Unused Xref and Image
;;; posted VVA http://forum.dwg.ru/showthread.php?t=4983  
  (vl-load-com)
  (defun *error* (msg)
    (princ msg)
    (mip:layer-status-restore)
    (princ)
  ) ;_ end of defun
  (vlax-for Blk (vla-get-Blocks (vla-get-activedocument (vlax-get-acad-object)))
    (if (= (vla-get-IsXref Blk) :vlax-false)
     (progn
    (princ "\nWait... the search for rasters in ")(princ (vla-get-name blk))
    (vlax-for item Blk
      (cond
        ((and
           (eq (vla-get-objectname item) "AcDbRasterImage")
           (setq file (vla-get-imagefile item))
         ) ;_ end of and
         (setq used_raster_image_name (cons (vla-get-name item) used_raster_image_name))
        )
        (t nil)
      ) ;_ end of cond
    ) ;_ end of vlax-for
    )
      )
  (princ " ...OK")
  ) ;_ end of vlax-for
  (setq all_image
                 (mapcar 'cdr
                         (vl-remove-if-not
                             (function (lambda (x) (= 3 (car x))))
                             (dictsearch (namedobjdict) "ACAD_IMAGE_DICT")
                         ) ;_ end of vl-remove-if-not
                 ) ;_ end of mapcar
        ) ;_ end of setq  
  (setq used_raster_image_name  (mip_MakeUniqueMembersOfList used_raster_image_name))
  (setq used_raster_image_name (vl-remove-if-not '(lambda(x)(= (type x) 'STR)) used_raster_image_name))
  (setq used_raster_image_name (mapcar 'strcase used_raster_image_name))
  (setq all_image (mapcar 'strcase all_image))
  (mapcar '(lambda (img) (setq all_image (vl-remove img all_image)))
        used_raster_image_name
    ) ;_ end of mapcar
  (princ "\nTotal: ")
  (princ (length all_image))(princ " unused rasters")
  (if all_image
    (progn
      (initget "Yes No")
      (setq pat (getkword "  Delete unused  image[Yes/No] <Yes>: "))
      (if (/= pat "No")
        (progn
          (mip:layer-status-save)
          (mapcar '(lambda(x)(vl-catch-all-apply 'DetachImage (list x))) all_image)
          (mip:layer-status-restore)
          )
        )
      )
    )
  (princ)
  )
(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
;;; http://forum.dwg.ru/showthread.php?t=4983
  (vl-load-com)
  (defun *error* (msg)
    (princ msg)
    (mip:layer-status-restore)
    (princ)
  ) ;_ 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)
)
(defun mip_MakeUniqueMembersOfList  ( lst / OutList head)
;;;Удаляет одинаковые (дубликаты) элементы из списка
;;; На основе http://www.theswamp.org/index.php?topic=19128.0
;;; Изменено для сравнения вещественных чисел (equal ... 1e-6)
  (while lst
    (setq head (car lst)
          OutList (cons head OutList)
          lst (vl-remove-if '(lambda(pt)(equal pt head 1e-6))(cdr lst))
          )
    )
  (reverse OutList)
  )
  (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

kserg · 21.07.2009, 13:23

Спасибо!

Кочетков Андрей · 06.11.2009, 13:24

Володь хотел уточнить: код DUXI (http://forum.dwg.ru/showpost.php?p=424108&postcount=15) делает тоже самое что и код в этой теме?

VVA · 07.11.2009, 14:29

Да. Просто здесь IMGDET и DUXI объединены (они используют несколько общих функций). Раньше они были локальными для каждой команды. Просто код получается короче.

Кочетков Андрей · 09.11.2009, 09:25

Понял спасибо! )

shartal · 16.12.2015, 16:14

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

VVA · 16.12.2015, 18:46

Цитата:

Сообщение от shartal

При формировании комплекта в одну папку, у всех ссылок автоматом удаляются сохраненные пути и появляется только найденный путь

Цитата:

Сообщение от shartal

Как бы это исправить?.

Это про ETRANSMIT?

kp+ · 16.12.2015, 19:21

Цитата:

Сообщение от shartal

При формировании комплекта в одну папку, у всех ссылок автоматом удаляются сохраненные пути и появляется только найденный путь.

Навскидку, без проверки: в режимах ETRANSMIT есть галочки типа "ФСЁ в одну папку" и "Сохранять структуру папок". Если для результата ETRANSMIT, когда все скинуто в одну папку, применить ETRANSMIT еще раз в режиме "Сохранять структуру папок", не вернуться ли сохраненные пути назад? Тогда добавится одно "лишнее" движение, но ничего нигде не надо поправлять

19.12.2005, 16:06		#1
Как автоматизировать отсоединение неиспользуемых IMAGE? kp+ идущий по граблям Регистрация: 26.05.2005 Сообщений: 5,095 При длительной работе с Rasterex в чертеже накапливается куча неиспользуемых (unreferenced) растровых изображений. Перед сохранением чертежа их надо отсоединять (detach), иначе Rasterex предложит сохранить каждое из них. Ничего сложного тут нет, но если забыть это сделать, приходится отвечать "нет" на запрос сохранения каждого из этих изображений. А это уже муторно. Хотелось бы как-то объединить операции сохранения чертежа и "PURGE" этого мусора. В общем, подскажите, PLS, как автоматизировать отсоединение неиспользуемых растровых изображений?
Просмотров: 11488

	Реклама i