[编程交流] 使用visu打开并发送电子邮件

 
(defun C:CreateMail ()
; Who's going to get the mail
(setq recipients_list (list "[email="holsinf@stig.co.nz"]holsinf@stig.co.nz[/email]"))
; What is the subject
(setq subject "Subject of the mail")
; What is the body
(setq body "Body of the mail")
; What are the attachments
(setq attachments_list (list "MyDrawing.dwg"))
;;;(create-email recipients_list subject body attachments_list 1) ; Do send this mail immediately
(create-email recipients_list subject body attachments_list 0) ; Do not yet send this mail
(princ)
)
(defun create-email (recipients_list
subject body
attachments_list email_send
/ acadapp
acaddoc outlookapp
mail_object recipients_collection
attachments_collection
temp ret
item cadz3d_function
)
;; Load the extended AutoLISP functions and ActiveX support
(vl-load-com)
;; Get the application and current document objects
(setq acadapp (vlax-get-acad-object)
acaddoc (vlax-get-property acadapp 'activedocument)
)
;; Get the existing outlook application object
(if
(or (= (setq outlookapp (vl-catch-all-apply 'vlax-get-object (list
"Lotus Notes.Application")));
nil
)
(/= (type outlookapp) 'vla-object)
)
(progn (alert (strcat
"Microsoft Outlook must already be running\n"
"to create and send the email. This will be\n"
"improved in future versions.\n\n"
"Please start Microsoft Outlook and then close\n"
"this dialog box to create the email."
)
)
(setq outlookapp (vl-catch-all-apply 'vlax-get-object (list 
"Lotus notes.Application")))
)
)
(if (= (type outlookapp) 'vla-object)
(if ;; Create new email object
(setq mail_object (vlax-invoke-method outlookapp 'createitem 0))
(if ;; Get the recipients collection
(setq recipients_collection (vlax-get-property mail_object 'recipients))
(progn
;; Add the recipients properties to the email
(foreach item recipients_list
(if (= (type item) 'str)
(vlax-invoke-method recipients_collection 'add item)
)
)
;; Add the subject properties to the email
(if (= (type subject) 'str)
(vlax-put-property mail_object 'subject subject)
)
;; Add the body properties to the email
(if (= (type body) 'str)
(vlax-put-property mail_object 'body body)
)
;; Add the attachements properties to the email
(if
(and (vl-consp attachments_list)
(setq attachments_collection (vlax-get-property mail_object 
'attachments))
)
(foreach item attachments_list
(if (and (setq temp (findfile item)) (vl-file-systime temp))
(vlax-invoke-method attachments_collection 'add temp)
)
)
)
;; If the email_send equals 1 and the recipients_list, subject, and body 
;;;were passed to the
;; function then send the email, otherwise display the email for the user 
;;;to finish
(if (and (= email_send 1)
(vl-consp recipients_list)
;;;subject
;;;body
(/= subject "")
(/= body "")
)
(vlax-invoke-method mail_object 'send)
(vlax-invoke-method mail_object 'display)
)
(setq ret t)
)
(princ "\nCould not get the recipients collection from the new mail item")
)
(princ "\nCould not create a new mail item through Outlook")
)
(princ "\nCould not create a new instance of Outlook")
)
;; Release the objects
(if (and (= (type attachments_collection) 'vla-object)
(= (vlax-object-released-p attachments_collection) nil)
)
(vlax-release-object attachments_collection)
)
(if (and (= (type recipients_collection) 'vla-object)
(= (vlax-object-released-p recipients_collection) nil)
)
(vlax-release-object recipients_collection)
)
(if (and (= (type mail_object) 'vla-object) (= (vlax-object-released-p 
mail_object) nil))
(vlax-release-object mail_object)
)
(if (and (= (type outlookapp) 'vla-object) (= (vlax-object-released-p
outlookapp) nil))
(vlax-release-object outlookapp)
)
(if (and (= (type acaddoc) 'vla-object) (= (vlax-object-released-p
acaddoc) nil))
(vlax-release-object acaddoc)
)
(if (and (= (type acadapp) 'vla-object) (= (vlax-object-released-p
acadapp) nil))
(vlax-release-object acadapp)
)
(princ)
ret
);defun