| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Как автоматизировать отсоединение неиспользуемых IMAGE?

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

Ответ
Поиск в этой теме
Непрочитано 19.12.2005, 16:06 #1
Как автоматизировать отсоединение неиспользуемых IMAGE?
kp+
 
идущий по граблям
 
Регистрация: 26.05.2005
Сообщений: 5,067

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

В общем, подскажите, PLS, как автоматизировать отсоединение неиспользуемых растровых изображений?
Просмотров: 11400
 
Автор темы   Непрочитано 20.12.2005, 17:48
#2
kp+

идущий по граблям
 
Регистрация: 26.05.2005
Сообщений: 5,067


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

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

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

Подскажите, PLS!
kp+ вне форума  
 
Непрочитано 20.12.2005, 18:55
1 | #3
fixo

Lisp/VBA/VB.NET Hobbyist
 
Регистрация: 24.03.2005
Славен Град Петров
Сообщений: 367


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

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

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

Подскажите, PLS!
Сам словарь достать несложно:

Код:
[Выделить все]
(dictsearch (namedobjdict) "ACAD_IMAGE_DICT")
Гораздо сложнее найти неиспользуемые IMAGE, если найдешь,
тогда остальные вхождения IMAGE_DEFINITION отсеешь от тех
что вставлены:

Код:
[Выделить все]
(ssget "_X" (list (cons 0 "IMAGE")))
Нет времени поворчать над такой сахарной косточкой...

~'J'~
fixo вне форума  
 
Автор темы   Непрочитано 21.12.2005, 10:31
#4
kp+

идущий по граблям
 
Регистрация: 26.05.2005
Сообщений: 5,067


Спасибо, это как раз то, что надо.
Примочка заработала.
kp+ вне форума  
 
Непрочитано 21.12.2005, 10:34
#5
fixo

Lisp/VBA/VB.NET Hobbyist
 
Регистрация: 24.03.2005
Славен Град Петров
Сообщений: 367


Цитата:
Сообщение от kp+
Спасибо, это как раз то, что надо.
Примочка заработала.
Если все получится выложи для других, может кто
тоже интересуется

~'J'~
fixo вне форума  
 
Автор темы   Непрочитано 23.12.2005, 10:42
#6
kp+

идущий по граблям
 
Регистрация: 26.05.2005
Сообщений: 5,067


Вот она, моя прога. Сделана по-простому. Не судите слишком строго.
Проверялась на 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);отсоединение неиспользуемых
)
kp+ вне форума  
 
Непрочитано 23.12.2005, 16:28
#7
fixo

Lisp/VBA/VB.NET Hobbyist
 
Регистрация: 24.03.2005
Славен Град Петров
Сообщений: 367


Молодца!


~'J'~
fixo вне форума  
 
Непрочитано 23.07.2007, 14:43
1 | #8
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,989
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Удаление неиспользуемых 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)

Последний раз редактировалось VVA, 19.09.2015 в 12:03.
VVA вне форума  
 
Непрочитано 22.05.2009, 18:57
#9
kserg


 
Регистрация: 22.04.2004
Сообщений: 269


Уважаемый VVA, время прошло немалое, код остался преждним ?
kserg вне форума  
 
Непрочитано 23.05.2009, 20:43
#10
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,989
<phrase 1= Отправить сообщение для VVA с помощью Skype™


А что, не работает? У меня к нему претензий пока нет.
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 26.05.2009, 14:04
#11
kserg


 
Регистрация: 22.04.2004
Сообщений: 269


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

Спасибо, работает (спасает часто...). Просто хотелось узнать, может появились обновления к програмке.
kserg вне форума  
 
Непрочитано 17.07.2009, 14:27
#12
kserg


 
Регистрация: 22.04.2004
Сообщений: 269


> VVA

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

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,989
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Так как они используют общие ф-ции, то объединил 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
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 21.07.2009, 13:23
#14
kserg


 
Регистрация: 22.04.2004
Сообщений: 269


Спасибо!
kserg вне форума  
 
Непрочитано 06.11.2009, 13:24
#15
Кочетков Андрей

Java/Kotlin backend
 
Регистрация: 03.02.2006
Сообщений: 5,720


Володь хотел уточнить: код DUXI (http://forum.dwg.ru/showpost.php?p=424108&postcount=15) делает тоже самое что и код в этой теме?
Кочетков Андрей вне форума  
 
Непрочитано 07.11.2009, 14:29
#16
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,989
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Да. Просто здесь IMGDET и DUXI объединены (они используют несколько общих функций). Раньше они были локальными для каждой команды. Просто код получается короче.
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 09.11.2009, 09:25
#17
Кочетков Андрей

Java/Kotlin backend
 
Регистрация: 03.02.2006
Сообщений: 5,720


Понял спасибо! )
Кочетков Андрей вне форума  
 
Непрочитано 16.12.2015, 16:14
#18
shartal


 
Регистрация: 12.08.2009
Сообщений: 446


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

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,989
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Цитата:
Сообщение от shartal Посмотреть сообщение
При формировании комплекта в одну папку, у всех ссылок автоматом удаляются сохраненные пути и появляется только найденный путь
Цитата:
Сообщение от shartal Посмотреть сообщение
Как бы это исправить?.
Это про ETRANSMIT?
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Автор темы   Непрочитано 16.12.2015, 19:21
#20
kp+

идущий по граблям
 
Регистрация: 26.05.2005
Сообщений: 5,067


Цитата:
Сообщение от shartal Посмотреть сообщение
При формировании комплекта в одну папку, у всех ссылок автоматом удаляются сохраненные пути и появляется только найденный путь.
Навскидку, без проверки: в режимах ETRANSMIT есть галочки типа "ФСЁ в одну папку" и "Сохранять структуру папок". Если для результата ETRANSMIT, когда все скинуто в одну папку, применить ETRANSMIT еще раз в режиме "Сохранять структуру папок", не вернуться ли сохраненные пути назад? Тогда добавится одно "лишнее" движение, но ничего нигде не надо поправлять
kp+ вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Как автоматизировать отсоединение неиспользуемых IMAGE?

Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск