俞雲霨工作室

將指定目錄下所有圖檔都建立(.sld)幻燈片_Y543(20131116)
(本程式2013/11/04首次發表於AutoCAD顧問論壇)

;;將指定目錄下所有圖檔都建立(.sld)幻燈片
;;會覆蓋原有(.sld)幻燈片檔案，原有(.dwg)檔案不會更改
;;圖檔名稱不能有"(" ")"符號
;;for AutoCAD 2013 中文版之 AutoLISP
;; 2013/11/16

(defun C:Y543 (/ scm *ERROR* dir:file dir_path scr:path file_list scr:file i)
    (setq scm (getvar "cmdecho"))
    (setvar "cmdecho" 0)
    (vl-load-com)

    (defun *ERROR* (msg)
        ;;(:Ys+var:)
        (setvar "clayer" "0")
        (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
            (princ (strcat "\n*** Error: " msg " ***")))
    (princ) )

    (if (or (= (getvar "SDI") 0) (> (getvar "DBMOD") 0))
        (progn
            (setq dir:file  (getfiled "選取BLOCK檔案目錄" "" "dwg" 2))
            (setq dir_path  (strcat (vl-filename-directory dir:file) "\\")) ;; 目錄路徑
            (setq scr:path  (strcat dir_path "Y543.scr"))                   ;; 腳本路徑
            (setq file_list (vl-directory-files dir_path "*.dwg" 1)) ;; 目錄路徑下所有(.dwg)圖檔
            (alert (strcat "共選取 " (itoa (length file_list)) " 個圖檔，請按【確定】繼續執行... "))
            (setq i 0)
            (repeat (length file_list)
                (setq scr:file (open scr:path "w"))
                (foreach dwg file_list
                    (write-line "._OPEN" scr:file)
                    (write-line (strcat "\"" dir_path dwg "\"") scr:file)
                    (write-line "(command \"._ZOOM\" \"_E\" \"._ZOOM\" \"_S\" \"0.95x\")" scr:file)
                    (write-line "(command \"._MSLIDE\" (strcat (getvar \"dwgprefix\")
                                 (vl-filename-base (getvar \"dwgname\")) \".sld\"))" scr:file)
                    (write-line "._CLOSE" scr:file)
                    (write-line "_Y" scr:file)
                    (setq i (1+ i)) )
                (close scr:file)
            )   (command "._SCRIPT" scr:path)
    )   )

    (princ "\n****** End!  結束! ******")
    (setvar "cmdecho" scm)
(princ)
)
(prompt "\n****** Load << 將指定目錄下所有圖檔都建立(.sld)幻燈片 >> Successful ******")
(prin1)