[编程交流] 互联网新闻阅读器

(defun c:RSS (/ url Data RSS Items link)
 [color=Red];; © Lee Mac  ~  07.06.10 (modified by Alan J. Thompson)[/color]
 (setq url "http://newsrss.bbc.co.uk/rss/newsonline_uk_edition/front_page/rss.xml")
 (if (setq Data (VK_ReadXML url))
   (progn
     (setq RSS (caddr (car (caddr (caddr Data)))))
     (setq Items (RemoveTilFoo (lambda (x) (eq "item" (strcase (car x) t))) RSS))
     (if (and (setq Items (mapcar 'caddr Items))
              (setq Items (SubList Items 0 10))
              (setq Items
                     (mapcar
                       (function
                         (lambda (x)
                           (list (caddr (car x)) (caddr (caddr x)))
                         )
                       )
                       Items
                     )
              )
              (setq link (dos_popupmenu (mapcar 'car Items)))
         )
       (command "_.browser" (cadr (nth link Items)))
     )
   )
 )
 (princ)
)
(defun RemoveTilFoo (foo lst)
 ;; © Lee Mac  ~  07.06.10
 (while (and lst (not (foo (car lst))))
   (setq lst (cdr lst))
 )
 lst
)
(defun SubList (lst start len)
 ;; © Lee Mac  ~  07.06.10
 (if lst
   (if (< 0 start)
     (SubList (cdr lst) (1- start) len)
     (if (< 0 len)
       (cons (car lst)
             (SubList (cdr lst) start (1- len))
       )
     )
   )
 )
)
;; .....................................................................;;
;;                   -- VovKa's XML Functions --                        ;;
;; .....................................................................;;
(defun vk_XMLGetAttributes (Node / Attributes Attribute OutList)
 (if (setq Attributes (vlax-get Node "attributes"))
   (progn (while (setq Attribute (vlax-invoke Attributes "nextNode"))
            (setq OutList (cons (cons (vlax-get Attribute "nodeName")
                                      (vlax-get Attribute "nodeValue")
                                )
                                OutList
                          )
            )
            (vlax-release-object Attribute)
          )
          (vlax-release-object Attributes)
          (reverse OutList)
   )
 )
)
;;;(vk_XMLGetAttributes Node)
(defun vk_XMLGetchildNodes (Node /)
 (if Node
   (if (= (vlax-get Node "nodeType") 3)
     (vlax-get Node "nodeValue")
     (append (list
               (list (vlax-get Node "nodeName")
                     (vk_XMLGetAttributes Node)
                     (vk_XMLGetchildNodes (vlax-get Node "firstChild"))
               )
             )
             (vk_XMLGetchildNodes (vlax-get Node "nextSibling"))
     )
   )
 )
)
;;;(vk_XMLGetchildNodes Node)
(defun vk_ReadXML (FileName / Doc OutList *error*)
 (if (and FileName
;;;       (setq FileName (findfile FileName))
          (setq Doc (vlax-create-object "MSXML.DOMDocument"))
          (not (vlax-put Doc "async" 0))
          (if (= (vlax-invoke Doc "load" FileName) -1)
            t
            (prompt
              (strcat "\nError: "
                      (vlax-get (vlax-get Doc "parseError") "reason")
              )
            )
          )
          (= (vlax-get Doc "readyState") 4)
     )
   (setq OutList (vk_XMLGetchildNodes (vlax-get Doc "firstChild")))
 )
 (and Doc (vlax-release-object Doc))
 (gc)
 OutList
)
;;;(vk_ReadXML (getfiled "" "" "xml" 16))

;Lee Mac 7.6.10 ;Space declaration statement (setq spc   (if     (or       (eq AcModelSpace         (vla-get-ActiveSpace           (setq doc             (vla-get-ActiveDocument               (vlax-get-acad-object)             )           )         )       )       (eq :vlax-true (vla-get-MSpace doc))     )     (vla-get-ModelSpace doc)     (vla-get-PaperSpace doc)   ) )