DenSien その1 (少し長い)

スライドを作成する部分がほぼ完成。
(command "close")がIntellicadではうまく動作しないので、スクリプトを使用。

*****LSPファイル
;***************************************
;***************************************
;;DenSien(電気図作成支援アプリケーション）
;;File Name "DenAux.lsp"
;;Command Name "dena"
;;
;;By Kim Grossa
;;Ver1.0 December 23,2008
;;
;;Action "Slideの作成"
;;
;;How to Use
;;(1) DenAux.dclを使用。
;;(2) DOSLib.drxのロードが必要。
;;(3) (command "close")がうまく動作しないので、スクリプトを使用。
;;(4) 選択したディレトリにSLDファイルがある場合、上書きするかどうか確認する。
;;(5)Bricscad Pro Version 8.2.10で動作確認。
;;
;;THANKS To
;;http://www.afralisp.net/
;;http://www.jefferypsanders.com/autolisp.html
;;http://web2.airmail.net/terrycad/Tutorials/MyDialogs.htm
;;http://en.wiki.mcneel.com/default.aspx/McNeel/DOSLib.html
;***************************************
;***************************************
;
;-----Start of File-----

;----------------------------
;初期設定 InitSet
;----------------------------
(defun InitSet()
(setq SELDIR "")
);defun


;----------------------------
;ディレクトリの選択 SelectDir
;----------------------------
(defun SelectDir()
(setq SELDIR (dos_getdir "フォルダを選択して下さい。" "C:\\Program Files\\Bricsys\\Bricscad\\DenSien\\DenBuroV1_1\\"
""))
);defun


;----------------------------
;スライドの作成 MakeSlide
;----------------------------
;-----------------------------
(defun MakeSlide(/ dwglist dwgnum scrfile file1 cntr dwgnamelocal dwgnamefull sldnamefull flen len1 fname1)

(SelectDir) ;;スライドを作成するディレクトリを選択

(if (/= SELDIR NIL) ;;ディレクトリの取得に成功
(progn
(dos_chdir SELDIR) ;;カレントディレクトリを選択したディレクトリに変更
(setq dwglist (dos_dir "*.dwg" )) ;;DWGファイルのリストを取得
(setq dwgnum (length dwglist)) ;;DWGファイルの数を取得
(setq sldlist (dos_dir "*.sld" )) ;;SLDファイルのリストを取得
(setq sldnum (length sldlist)) ;;SLDファイルの数を取得

(if (/= sldnum 0) ;;選択したディレクトリ配下にSLDファイルがある場合
(progn
(initget 1 "Yes No")
(setq ans (getkword "SLDファイルを上書きしますか？(Yes/No)"))
(if (/= ans "Yes")
(exit) ;;Yesでなければ終了
);if
);progn
);if

(if (/= dwgnum 0) ;;dwgファイルの取得に成功
(progn
(setq scrfile (strcat SELDIR "batdir.scr")) ;;フルパス表示(スクリプトファイル）
(setq file1 (open scrfile "w")) ;;スクリプトファイルを開く
(setq cntr 1) ;;カウンターの設定

(repeat (- dwgnum 1) ;;ループの開始
(setq dwgnamelocal (nth cntr dwglist)) ;;ローカルパス表示(DWGファイル）
(setq dwgnamefull (strcat SELDIR dwgnamelocal)) ;;フルパス表示（DWGファイル）

(setq flen (strlen dwgnamefull)) ;;DWGファイル名の文字数を取得
(setq len1 (- flen 4)) ;;最後の4文字を取り除く (.DWG)
(setq sldnamefull (substr dwgnamefull 1 len1)) ;;フルパス表示(拡張子なし）
(setq sldnamefull (strcat sldnamefull ".sld")) ;;フルパス表示(SLDファイル）

(write-line (strcat "open " dwgnamefull) file1) ;;DWGファイルを開く
(write-line (strcat "zoom" " e") file1) ;;Zoom e
(write-line (strcat "filedia" " 0") file1) ;;ダイアログをOFF
(write-line (strcat "mslide " sldnamefull) file1) ;;スライドを作成
(write-line (strcat "filedia" " 1") file1) ;;ダイアログをON
(write-line "qsave" file1) ;;DWGファイルを保存
(write-line (strcat "close" ) file1) ;;DWGファイルを閉じる
(setq cntr (1+ cntr)) ;;カウンターを1つ増やす
);repeat

(close file1) ;;スクリプトファイルを閉じる
(command "script" scrfile) ;;スクリプトファイルを実行

);progn
(alert "DWGファイルはありません。") ;;dwgファイルの取得に失敗
);if
);progn
(alert "フォルダが選択されませんでした。") ;;ディレクトリの取得に失敗
);if
);defun


;-----------------------------
;DenAuxの終了 QuitDenAux
;-----------------------------
(defun QuitDenAux()
(exit)
);defun


;-----------------------------
;Dialogの表示 DispDialog
;-----------------------------
(defun DispDialog(/ DclId)

(setq DclId (load_dialog "DenAux.dcl")) ;; Load Dialog
(new_dialog "DenAux" DclId)

(set_tile "Title" "DenAux") ;; Set Dialog Initial Settings

(action_tile "MakeSlide" "(done_dialog)(MakeSlide)")
(action_tile "Quit" "(done_dialog)(QuitDenAux)")

(start_dialog) ;;Start Dialog
(unload_dialog DclId) ;; Unload Dialog
);defun


;-----------------------------
;メイン command name dena
;-----------------------------
(defun C:dena()
(InitSet) ;初期設定
(DispDialog) ;Dialogの表示
;(SelectDir) ;ディレクトリの選択
;(MakeSlide) ;スライドの作成


);defun C:dena

(princ "\nType dena to start DenAux......")
(terpri)

;-----End of File-----

*****DCLファイル
//---------------------------------------------------------------------------------------------------------
// DenAux.dcl
//-----DenAux.lsp
//---------------------------------------------------------------------------------------------------------
DenAux : dialog {
key = "Title";
label = "";
fixed_width = true;
alignment = centered;
: button {
key = "MakeSlide";
label = "SLDファイルを作成";
width = 20;
}
: button {
key = "Quit";
label = "終了";
width = 20;
}

}