Информационный портал для профессионалов в области САПР
Вы не вошли. Пожалуйста, войдите или зарегистрируйтесь.
Форумы CADUser → Программирование → Разное → Импорт-экспорт растровых изображений
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Часто приходится из одного документа переносить растры в другой. Copy-Paste не всегда устраивает.
Возможно ли сделать так, чтобы полный путь выбранных растров импортировался в текстовый файл (необходим для разных целей), а также потом можно было загрузить растры в новый документ следуя путям прописанным в этом текством файле.
Пробуй так
;!!!!!!!!!!!!!!!!!!!! Сервисные ф-ции !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
;|=======================================================================================
* Функция возвращает vla-активное пространство (лист / модель).
* Параметры вызова:
* Нет
* Примеры вызова:
(lib:get-active-space)
=======================================================================================|;
(defun lib:get-active-space ()
(if (and (zerop (vla-get-activespace (vla-get-activedocument (vlax-get-acad-object))))
(= :vlax-false (vla-get-mspace (vla-get-activedocument (vlax-get-acad-object))))
) ;_ end of and
(vla-get-paperspace (vla-get-activedocument (vlax-get-acad-object)))
(vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
)) ;_ end of defun
;|=============================================================================
* Конвертация списка точек вида ((0.0 0.0 0.0) (10.0 10.0 0.0) ...) в массив
* для передачи в activeX для рисование объектов.
* Параметры вызова:
* point-list список точек. Не может быть nil.
* Примеры вызова:
(lib:pointlist-to-variant (list '(0 0 0) '(1 2 3)))
=============================================================================|;
(defun lib:pointlist-to-variant (point-list / safe_list result)
(setq point-list (apply 'append point-list))
(setq safe_list (vlax-make-safearray
vlax-vbdouble
(cons 0 (1- (length point-list)))
) ;_ end of vlax-make-safearray
) ;_ end of setq
(setq result (vlax-safearray-fill safe_list point-list))
(vlax-make-variant result)) ;_ end of defun
;|=============================================================================
* Функция преобразования набора, полученного через (ssget), в список
* ename-примитивов.
* Параметры вызова:
* selset набор примитивов
* Примеры вызова:
(lib:selset-to-enamelist (ssget))
=============================================================================|;
(defun lib:selset-to-enamelist (selset)
(if selset
(vl-remove-if 'listp (mapcar 'cadr (ssnamex selset)))
)) ;_ end of defun
;|=============================================================================
* Функция преобразования набора, полученного через (ssget), в список
* vla-примитивов.
* Параметры вызова:
* selset набор примитивов
* Примеры вызова:
(lib:selset-to-vlalist (ssget))
=============================================================================|;
(defun lib:selset-to-vlalist(selset)
(if selset
(mapcar 'vlax-ename->vla-object
(lib:selset-to-enamelist selset)
))) ;_ end of defun
;!!!!!!!!!!!!!!!!!!!! Сервисные ф-ции !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
(defun C:imgEXP ( / image_set image_list fls fil str)
(setq image_set nil
image_set (ssget "_X" '((0 . "IMAGE")))
)
(if (null *LAST_DIR*) (setq *LAST_DIR* "C:\\"))
(if (and image_set
(setq fls (getfiled "Файл для сохранения данных" *LAST_DIR* "ims" 17)))
(progn
(setq *LAST_DIR* (strcat (vl-filename-directory fls) "\\"))
(VL-PROPAGATE '*LAST_DIR*)
(setq fil (open fls "w"))
(setq image_list (LIB:SELSET-TO-VLALIST image_set))
(foreach item image_list
(setq str (strcat
(vla-get-Name item) ;_0 Имя
";"
(vla-get-ImageFile item);_1 Путь
";"
(VL-PRINC-TO-STRING
(vlax-safearray->list
(vlax-variant-value (vla-get-Origin item)))) ;_2 ТВС
";"
(VL-PRINC-TO-STRING
(vla-get-ScaleFactor item)) ;_3 Масштаб
";"
(VL-PRINC-TO-STRING
(vla-get-Rotation item)) ;_4 Поворот
";"
(VL-PRINC-TO-STRING
(vla-get-Transparency item)) ;_5 Прозрачность
";"
(VL-PRINC-TO-STRING
(vla-get-ImageHeight item)) ;_6 Высота
";"
(VL-PRINC-TO-STRING
(vla-get-ImageWidth item)) ;_7 Ширина
))
(WRITE-LINE str fil)
)
(close fil)))
)
(defun C:imgIMP ( / fls fil str sps tmp)
(setvar "CMDECHO" 0)
(if (null *LAST_DIR*) (setq *LAST_DIR* "C:\\"))
(setq fls (getfiled "Выберите файл для вставки" *LAST_DIR* "ims" 16))
(if fls
(progn
(setq fil (open fls "r"))
(while (setq str (read-line fil))
(setq sps (str-str-lst str ";"))
;;;Если файл есть
(if (setq tmp (open (nth 1 sps) "r"))
(progn
(close tmp)
(setq img (vla-AddRaster (lib:get-active-space)
(nth 1 sps)
(LIB:POINTLIST-TO-VARIANT (list (read (nth 2 sps))))
(read (nth 3 sps))
(read (nth 4 sps))))
(vla-put-Transparency img (read (nth 5 sps)))
(vla-put-Name img (nth 0 sps))
(vla-put-ImageHeight img (read (nth 6 sps)))
(vla-put-ImageWidth img (read (nth 7 sps)))
)
(princ
(strcat "\nФайл "
(nth 1 sps)
" не найден")))
);_while
(close fil)
)
)
(princ)
)
(princ "\n Наберите imgEXP -> Экспорт \n imgIMP -> Импорт растров")Плюс забытая ф-ция
;|
* Ф-ция str-str-lst
* Сервисная ф-ция извлечения из строки данных, разделенных
* каким либо символом или строкой символов
* Возвращает список строк
* Аргументы [Type]:
str - строка для разбора [STRING]
pat - разделитель [STRING]
* Пример запуска
(setq str "мы;изучаем;рекурсии" pat ";")
(setq str "мы — изучаем — рекурсии" pat " — ")
(str-str-lst str pat)
* Читать подробнее https://www.caduser.ru/forum/topic25197.html
|;
(defun str-str-lst (str pat / i)
(cond ((= str "") nil)
((setq i (vl-string-search pat str))
(cons (substr str 1 i)
(str-str-lst (substr str (+ (strlen pat) 1 i)) pat)
) ;_ cons
)
(t (list str))
) ;_ cond
) ;_ defun> VVA
Спасибо за неоднократную помощь, все работает.
Но один ньюанс, очень часто, путь прописанный в менеджере изображений невеный и автокад ищет изображения в той же папке, что и *.dwg. Нельзя ли, чтобы экспортировался реальный, а не прописанный путь.
Исправлено. Теперь если раст не найден по прописанному пути, он ищется по правивал Автокада.
;!!!!!!!!!!!!!!!!!!!! Сервисные ф-ции !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
;|=======================================================================================
* Функция возвращает vla-активное пространство (лист / модель).
* Параметры вызова:
* Нет
* Примеры вызова:
(lib:get-active-space)
=======================================================================================|;
(defun lib:get-active-space ()
(if (and (zerop (vla-get-activespace (vla-get-activedocument (vlax-get-acad-object))))
(= :vlax-false (vla-get-mspace (vla-get-activedocument (vlax-get-acad-object))))
) ;_ end of and
(vla-get-paperspace (vla-get-activedocument (vlax-get-acad-object)))
(vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
)) ;_ end of defun
;|=============================================================================
* Конвертация списка точек вида ((0.0 0.0 0.0) (10.0 10.0 0.0) ...) в массив
* для передачи в activeX для рисование объектов.
* Параметры вызова:
* point-list список точек. Не может быть nil.
* Примеры вызова:
(lib:pointlist-to-variant (list '(0 0 0) '(1 2 3)))
=============================================================================|;
(defun lib:pointlist-to-variant (point-list / safe_list result)
(setq point-list (apply 'append point-list))
(setq safe_list (vlax-make-safearray
vlax-vbdouble
(cons 0 (1- (length point-list)))
) ;_ end of vlax-make-safearray
) ;_ end of setq
(setq result (vlax-safearray-fill safe_list point-list))
(vlax-make-variant result)) ;_ end of defun
;|=============================================================================
* Функция преобразования набора, полученного через (ssget), в список
* ename-примитивов.
* Параметры вызова:
* selset набор примитивов
* Примеры вызова:
(lib:selset-to-enamelist (ssget))
=============================================================================|;
(defun lib:selset-to-enamelist (selset)
(if selset
(vl-remove-if 'listp (mapcar 'cadr (ssnamex selset)))
)) ;_ end of defun
;|=============================================================================
* Функция преобразования набора, полученного через (ssget), в список
* vla-примитивов.
* Параметры вызова:
* selset набор примитивов
* Примеры вызова:
(lib:selset-to-vlalist (ssget))
=============================================================================|;
(defun lib:selset-to-vlalist(selset)
(if selset
(mapcar 'vlax-ename->vla-object
(lib:selset-to-enamelist selset)
))) ;_ end of defun
;|* Ф-ция str-str-lst
* Сервисная ф-ция извлечения из строки данных, разделенных
* каким либо символом или строкой символов
* Возвращает список строк
* Аргументы [Type]:
str - строка для разбора [STRING]
pat - разделитель [STRING]
* Пример запуска
(setq str "мы;изучаем;рекурсии" pat ";")
(str-str-lst str pat)
* Читать подробнее http://www.autocad.ru/cgi-bin/f1/board.cgi?t=25113OT|;
(defun str-str-lst (str pat / i)
(cond ((= str "") nil)
((setq i (vl-string-search pat str))
(cons (substr str 1 i)
(str-str-lst (substr str (+ (strlen pat) 1 i)) pat)))
(t (list str))) ;_ cond
) ;_ defun
;!!!!!!!!!!!!!!!!!!!! Сервисные ф-ции !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
(defun C:imgEXP ( / image_set image_list fls fil str path)
(VL-LOAD-COM)
(setq image_set nil
image_set (ssget "_X" '((0 . "IMAGE")))
)
(if (null *LAST_DIR*) (setq *LAST_DIR* "C:\\"))
(if (and image_set
(setq fls (getfiled "Файл для сохранения данных" *LAST_DIR* "ims" 17)))
(progn
(setq *LAST_DIR* (strcat (vl-filename-directory fls) "\\"))
(VL-PROPAGATE '*LAST_DIR*)
(setq fil (open fls "w"))
(setq image_list (LIB:SELSET-TO-VLALIST image_set))
(foreach item image_list
(setq path (vla-get-ImageFile item));_1 Путь
(if (null (findfile path))
(setq path
(findfile
(strcat (VL-FILENAME-BASE path)(VL-FILENAME-EXTENSION path)))))
(if (null path)(setq path (vla-get-ImageFile item)))
(setq str (strcat
(vla-get-Name item) ;_0 Имя
";"
path ;_1 Путь
";"
(VL-PRINC-TO-STRING
(vlax-safearray->list
(vlax-variant-value (vla-get-Origin item)))) ;_2 ТВС
";"
(VL-PRINC-TO-STRING
(vla-get-ScaleFactor item)) ;_3 Масштаб
";"
(VL-PRINC-TO-STRING
(vla-get-Rotation item)) ;_4 Поворот
";"
(VL-PRINC-TO-STRING
(vla-get-Transparency item)) ;_5 Прозрачность
";"
(VL-PRINC-TO-STRING
(vla-get-ImageHeight item)) ;_6 Высота
";"
(VL-PRINC-TO-STRING
(vla-get-ImageWidth item)) ;_7 Ширина
))
(WRITE-LINE str fil)
)
(close fil)))
(princ))
(defun C:imgIMP ( / fls fil str sps tmp)
(VL-LOAD-COM)
(if (null *LAST_DIR*) (setq *LAST_DIR* "C:\\"))
(setq fls (getfiled "Выберите файл для вставки" *LAST_DIR* "ims" 16))
(if fls
(progn
(setq fil (open fls "r"))
(while (setq str (read-line fil))
(setq sps (str-str-lst str ";"))
;;;Если файл есть
(if (setq tmp (open (nth 1 sps) "r"))
(progn
(close tmp)
(setq img (vla-AddRaster (lib:get-active-space)
(nth 1 sps)
(LIB:POINTLIST-TO-VARIANT (list (read (nth 2 sps))))
(read (nth 3 sps))
(read (nth 4 sps))))
(vla-put-Transparency img (read (nth 5 sps)))
(vla-put-Name img (nth 0 sps))
(vla-put-ImageHeight img (read (nth 6 sps)))
(vla-put-ImageWidth img (read (nth 7 sps)))
)
(princ
(strcat "\nФайл "
(nth 1 sps)
" не найден"))));_while
(close fil)))
(vla-ZoomAll (vlax-get-acad-object))
(princ)
)
(princ "\n Наберите imgEXP -> Экспорт \n imgIMP -> Импорт растров")Все работает удовлетворительно. Спасибо!
Но, при иморте растра, он вставляется с незначительным смещением. Если повторить Експорт-Импорт несколько раз, смещение будет существенным.
И на сколько я понял можно только все растры экспортировать, но хотелось бы только выделенные.
Спасибо!
Вот вариант с предварительным выбором
;!!!!!!!!!!!!!!!!!!!! Сервисные ф-ции !!!!!!!!!!!!!!!!!!!!!!!!!!!
;|=============================================================================
* Функция возвращает vla-активное пространство (лист / модель).
* Параметры вызова:
* Нет
* Примеры вызова:
(lib:get-active-space)
=============================================================================|;
(defun lib:get-active-space ()
(if (and (zerop (vla-get-activespace (vla-get-activedocument
(vlax-get-acad-object))))
(= :vlax-false (vla-get-mspace (vla-get-activedocument
(vlax-get-acad-object))))
) ;_ end of and
(vla-get-paperspace (vla-get-activedocument (vlax-get-acad-object)))
(vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
)) ;_ end of defun
;|============================================================================
* Конвертация списка точек вида ((0.0 0.0 0.0) (10.0 10.0 0.0) ...) в
массив
* для передачи в activeX для рисование объектов.
* Параметры вызова:
* point-list список точек. Не может быть nil.
* Примеры вызова:
(lib:pointlist-to-variant (list '(0 0 0) '(1 2 3)))
============================================================================|;
(defun lib:pointlist-to-variant (point-list / safe_list result)
(setq point-list (apply 'append point-list))
(setq safe_list (vlax-make-safearray
vlax-vbdouble
(cons 0 (1- (length point-list)))
) ;_ end of vlax-make-safearray
) ;_ end of setq
(setq result (vlax-safearray-fill safe_list point-list))
(vlax-make-variant result)) ;_ end of defun
;|============================================================================
* Функция преобразования набора, полученного через (ssget), в список
* ename-примитивов.
* Параметры вызова:
* selset набор примитивов
* Примеры вызова:
(lib:selset-to-enamelist (ssget))
============================================================================|;
(defun lib:selset-to-enamelist (selset)
(if selset
(vl-remove-if 'listp (mapcar 'cadr (ssnamex selset)))
)) ;_ end of defun
;|===========================================================================
* Функция преобразования набора, полученного через (ssget), в список
* vla-примитивов.
* Параметры вызова:
* selset набор примитивов
* Примеры вызова:
(lib:selset-to-vlalist (ssget))
============================================================================|;
(defun lib:selset-to-vlalist(selset)
(if selset
(mapcar 'vlax-ename->vla-object
(lib:selset-to-enamelist selset)
))) ;_ end of defun
;|* Ф-ция str-str-lst
* Сервисная ф-ция извлечения из строки данных, разделенных
* каким либо символом или строкой символов
* Возвращает список строк
* Аргументы [Type]:
str - строка для разбора [STRING]
pat - разделитель [STRING]
* Пример запуска
(setq str "мы;изучаем;рекурсии" pat ";")
(str-str-lst str pat)
* Читать подробнее http://www.autocad.ru/cgi-bin/f1/board.cgi?t=25113OT|;
(defun str-str-lst (str pat / i)
(cond ((= str "") nil)
((setq i (vl-string-search pat str))
(cons (substr str 1 i)
(str-str-lst (substr str (+ (strlen pat) 1 i)) pat)))
(t (list str))) ;_ cond
) ;_ defun
;!!!!!!!!!!!!!!!! Сервисные ф-ции !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
(defun C:imgEXP ( / image_set image_list fls fil str path image_set_prev)
(VL-LOAD-COM)
(setq image_set_prev (ssget "_I" '((0 . "IMAGE"))))
(if image_set_prev
(setq image_set image_set_prev
image_set_prev nil)
(setq image_set nil
image_set (ssget "_X" '((0 . "IMAGE")))))
(if (null *LAST_DIR*) (setq *LAST_DIR* "C:\\"))
(if (and image_set
(setq fls (getfiled "Файл для сохранения данных" *LAST_DIR* "ims"
17)))
(progn
(setq *LAST_DIR* (strcat (vl-filename-directory fls) "\\"))
(VL-PROPAGATE '*LAST_DIR*)
(setq fil (open fls "w"))
(setq image_list (LIB:SELSET-TO-VLALIST image_set))
(foreach item image_list
(setq path (vla-get-ImageFile item));_1 Путь
(if (null (findfile path))
(setq path
(findfile
(strcat (VL-FILENAME-BASE path)(VL-FILENAME-EXTENSION path)))))
(if (null path)(setq path (vla-get-ImageFile item)))
(setq str (strcat
(vla-get-Name item) ;_0 Имя
";"
path ;_1 Путь
";"
(VL-PRINC-TO-STRING
(vlax-safearray->list
(vlax-variant-value (vla-get-Origin item)))) ;_2 ТВС
";"
(VL-PRINC-TO-STRING
(vla-get-ScaleFactor item)) ;_3 Масштаб
";"
(VL-PRINC-TO-STRING
(vla-get-Rotation item)) ;_4 Поворот
";"
(VL-PRINC-TO-STRING
(vla-get-Transparency item)) ;_5 Прозрачность
";"
(VL-PRINC-TO-STRING
(vla-get-ImageHeight item)) ;_6 Высота
";"
(VL-PRINC-TO-STRING
(vla-get-ImageWidth item)) ;_7 Ширина
))
(WRITE-LINE str fil)
)
(close fil)))
(princ))
(defun C:imgIMP ( / fls fil str sps tmp)
(VL-LOAD-COM)
(if (null *LAST_DIR*) (setq *LAST_DIR* "C:\\"))
(setq fls (getfiled "Выберите файл для вставки" *LAST_DIR* "ims" 16))
(if fls
(progn
(setq fil (open fls "r"))
(while (setq str (read-line fil))
(setq sps (str-str-lst str ";"))
;;;Если файл есть
(if (setq tmp (open (nth 1 sps) "r"))
(progn
(close tmp)
(setq img (vla-AddRaster (lib:get-active-space)
(nth 1 sps)
(LIB:POINTLIST-TO-VARIANT (list (read (nth 2 sps))))
(read (nth 3 sps))
(read (nth 4 sps))))
(vla-put-Transparency img (read (nth 5 sps)))
(vla-put-Name img (nth 0 sps))
(vla-put-ImageHeight img (read (nth 6 sps)))
(vla-put-ImageWidth img (read (nth 7 sps)))
)
(princ
(strcat "\nФайл "
(nth 1 sps)
" не найден"))));_while
(close fil)))
(vla-ZoomAll (vlax-get-acad-object))
(princ)
)
(princ "\n Наберите imgEXP -> Экспорт \n imgIMP -> Импорт
растров")Что касается незначительного смещения, то окно св-в показывает координату
125.51756833, а запрос координаты из лиспа дает 125.518. Почему происходит
округление я не знаю, вопрос надо задать гурам Автокада
Все ясно.
СПАСИБО!
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Форумы CADUser → Программирование → Разное → Импорт-экспорт растровых изображений
Форум работает на PunBB, при поддержке Informer Technologies, Inc
