[编程交流] Lisp查找区域

DIR /b *.DWG > MyDrawingsList.SCR

_OPEN "[color=blue]C:\MyDrawings\Drawing1st.dwg[/color]" (if (ssget "_X" '((0 . "REGION"))) (progn (setq fis (open "[color=magenta]C:\\RegionQueryResults.txt[/color]" "a")) (write-line "[color=blue]Drawings1t.dwg[/color]" fis) (close fis))) _CLOSE
_OPEN "[color=blue]C:\MyDrawings\Drawing2nd.dwg[/color]" (if (ssget "_X" '((0 . "REGION"))) (progn (setq fis (open "[color=#ff00ff]C:\\RegionQueryResults.txt[/color]" "a")) (write-line "[color=blue]Drawing2nd.dwg[/color]" fis) (close fis))) _CLOSE
;end of script

[color=blue]//SERVER_NAME/[/color] /b *.DWG > MyDrawingsList.SCR

dir "\\SERVER_NAME\*.lsp" /s /b > mydrawingslist.scr

(defun c:findregions ( / f )
   (setq f [color=red]"C:\\RegionResults.txt"[/color]) ;; Output file
   (LM:odbx
      '(lambda ( x / r )
           (vl-catch-all-apply
              '(lambda nil
                   (vlax-for l (vla-get-layouts x)
                       (vlax-for o (vla-get-block l)
                           (if (= "AcDbRegion" (vla-get-objectname o))
                               (progn (setq r t) (exit))
                           )
                       )
                   )
               )
           )
           (if r
               (if (setq d (open f "a"))
                   (progn (write-line (vla-get-name x) d) (close d))
                   (prompt (strcat "\nUnable to open " f))
               )
           )
       )
       nil nil
   )
   (if (setq f (findfile f))
       (startapp "notepad" f)
       (prompt "\nNo regions found in any drawing.")
   )
   (princ)
)
(vl-load-com) (princ)