社区 › Auto Lisp › 互联网新闻阅读器

alanjt 发表于 2022-7-6 11:36:01

(defun c:RSS (/ url Data RSS Items link)
;; © Lee Mac~07.06.10 (modified by Alan J. Thompson)
(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))
 
很好的触摸李；很少有事情像计划周密的Lisp程序那么优雅

Lee Mac 发表于 2022-7-6 11:38:35

谢谢Ollie

alanjt 发表于 2022-7-6 11:43:44

...
 
LoL:LoL:

Lee Mac 发表于 2022-7-6 11:47:00

alanjt 发表于 2022-7-6 11:49:23

I'm sure there is and if I had a use for something like this, I might consider making an attempt. I only wanted to show an example of not using text (which is why I used the bulk of your code). I'll happily stick with the Google reader.

Lee Mac 发表于 2022-7-6 11:52:25

I have no use for it either - but I get easily addicted to learning new things...

alanjt 发表于 2022-7-6 11:54:25

Ditto, but it's hard to justify coding for random stuff when at work.

ollie 发表于 2022-7-6 11:57:23

;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)   ) )
 
Nice touch Lee; few things are as elegant as well planned lisp

Lee Mac 发表于 2022-7-6 12:00:11

Thanks Ollie

alanjt 发表于 2022-7-6 12:04:38

...
 
LoL:lol:

查看完整版本: 互联网新闻阅读器