[a_tim]

Здравствуйте, часто нужно копировать часть чертежа (например план этажа), скопировать его в новый файл, вставить с оригинальными координатами и отправить по электронной почте через почтовую программу. Возможно ли автоматизировать подобный алгоритм через LISP? Заранее благодарен.

[Кулик Алексей aka kpblc]

_wblock чем не нравится?

[a_tim]

Сообщение от Кулик Алексей aka kpblc _wblock чем не нравится?

Только сохраняет в блок. Потом нужно его найти, вложить, отправить.
Хотелось бы автоматизировать все таки. Выделил, задал имя файла и место сохранения,в почтовике ввел получателя и тему и отправил (все вручную).

[Кулик Алексей aka kpblc]

a_tim, ты команду-то _.wblock потестируй - там есть все, кроме отправки.

[a_tim]

Команду протестировал сразу же. А вместе с отправкой можно?

[VVA]

Можно
Для Outloock

Код:

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

;;Отправка сообщений
;;http://www.theswamp.org/index.php?topic=14646.new#new
;;;(defun send_message (adr tema message Attachment / objOutlook MailItem AddAdresse objAttachment )
;;;  
;;;  (setq objOutlook (vlax-Create-Object "Outlook.Application"))
;;;  (if objOutlook
;;;    (progn
;;;      (setq MailItem (vlax-Invoke-Method objOutlook 'CreateItem 0))
;;;      (setq objMail (vlax-get-property Mailitem 'Recipients))
;;;      (setq AddAdresse (vlax-Invoke-Method objMail 'Add adr))
;;;      (setq objAttachment (vlax-get-property Mailitem 'Attachments))
;;;      (vlax-Invoke-Method objAttachment 'Add Attachment 1 1 Attachment)
;;;      (vlax-put-property Mailitem 'Subject tema)
;;;      (vlax-put-property Mailitem 'Body message)
;;;      (vlax-Invoke-Method MailItem 'Send)
;;;    ); end progn
;;;  ); end if
;;;
;;;  (vlax-invoke-method objOutlook "Quit")
;;;  (mapcar
;;;    (function (lambda (x)
;;;    (if
;;;      (and x (not (vlax-object-released-p x)))
;;;      (vlax-release-object x)
;;;    );end if
;;;  ))
;;;    (list AddAdresse objAttachment objMail MailItem objOutlook)
;;;  )
;;;  (setq objOutlook nil MailItem nil objMail nil objAttachment nil AddAdresse nil)
;;;  (gc)
;;;  (princ)
;;;); end defun

(defun mip:message_send (adr tema message Attachment send / objOutlook MailItem AddAdresse objAttachment )
  ;;;(mip:message_send "[email protected]" "TEST" "Message" "D:\Чертеж1.dwg" t)
  ;;;Подгототавливает письмо для отправки через OUTLOOK
  ;;; adr - адрес или nil
  ;;; tema - тема
  ;;; message - сообщение
  ;;;  Attachment - вложение или nil
  ;;; send t -send nil - not
;;; (setq adr nil tema "Test" message "Отправка на сводный" Attachment "D:\\rom.lsp" send nil)
  (or adr (setq send nil))
  (setq objOutlook (vlax-get-object "Outlook.Application"))
  (if (and (not objOutlook)(setq MailItem (findfile "outlook.vbs")))
    (progn
      (mip:xopen MailItem)
      (mip:WAIT 3)
    )
    )
  (setq MailItem 0.0)
  (while (and (not objOutlook)(not(setq objOutlook (vlax-get-object "Outlook.Application")))
              (< (setq MailItem (1+ MailItem)) 10.0)
              )
    (mip:WAIT 1)
    )
  (if objOutlook
    (progn
      (setq MailItem (vlax-Invoke-Method objOutlook 'CreateItem 0))
      (setq objMail (vlax-get-property Mailitem 'Recipients))
      (if adr (setq AddAdresse (vlax-Invoke-Method objMail 'Add adr)))
      (setq objAttachment (vlax-get-property Mailitem 'Attachments))
      (if Attachment
      (vlax-Invoke-Method objAttachment 'Add Attachment 1 1 Attachment))
      (if tema
      (vlax-put-property Mailitem 'Subject tema))
      (if message
      (vlax-put-property Mailitem 'Body message)
        )
      (if send
      (vlax-Invoke-Method MailItem 'Send)
        )
    ); end progn
  ); end if
 (if (not send)(vlax-Invoke-Method MailItem 'Display :vlax-true))
 ;;; (vlax-invoke-method objOutlook "Quit")
  (mapcar
    (function (lambda (x)
    (if
      (and x (not (vlax-object-released-p x)))
      (vlax-release-object x)
    );end if
  ))
    (list AddAdresse objAttachment objMail MailItem objOutlook)
  )
  (setq objOutlook nil MailItem nil objMail nil objAttachment nil AddAdresse nil)
  (gc)
  (princ)
)
(defun mip:xopen (name / di na sh)
;; Запуск приложений по расширениб  
;; get from Patrick_35
;; http://www.theswamp.org/index.php?topic=29548.0 
;;;Usage 
;;;(setq my_file (vva-xopen "c:/test.txt")) 
;;;(setq my_file (vva-xopen "c:/test.avi")) 
;;;(setq my_file (vva-xopen "c:/test.3gp")) 

  (and   (setq name (findfile name)) 
   (setq sh (vlax-create-object "Shell.Application")) 
   (setq di (vlax-invoke sh 'Namespace (vl-filename-directory name))) 
   (setq na (vlax-invoke di 'parsename (strcat (vl-filename-base name) (vl-filename-extension name)))) 
   (vlax-invoke-method na 'invokeverbex "open") 
  ) 
  (vlax-release-object sh) 
  na 
)

(defun mip:WAIT (Seconds / Stop)
	(setq Stop (+ (getvar "DATE") (/ Seconds 86400.0)))
	(while (> Stop (getvar "DATE"))
		(princ)
	)
)

Пример запуска с отправкой письма

Код:

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

;;;Outloock должен быть запущен
(mip:message_send
  "[email protected]" ;_ Почтовый адрес
   "Заголовок"  ;_Заголовок сообщения
   "Message"    ;_Сообщение
   "D:\Чертеж1.dwg" ;_Аттачмент. Обратить внимание на 2 слэша
    t               ;_Отправить письмо
  )

Если нужно принудительно запустить Outloock используется outlook.vbs.
Файл должен находится в путях поиска
PS

почтовике ввел получателя и тему и отправил (все вручную).

Тогда так
(пример запуска без отправки письма)

Код:

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

(mip:message_send
  nil ;_ Почтовый адрес
   ""  ;_Заголовок сообщения
   "Файл во вложении"    ;_Сообщение
   "D:\Чертеж1.dwg" ;_Аттачмент. Обратить внимание на 2 слэша
    nil               ;_Отправить письмо
  )

[a_tim]

VVA большое спасибо, подскажи пожалуйста какой командой запускать?

[VVA]

a_tim, примеры запуска даны в #6. Выделил красным

[gomer]

Offtop: давно тут муссируется идея чата для автокада, передача фрагмента чертежа через инет непосредственно в другой чертеж могла бы быть одной из его функций