DenSien InsertBlock.lsp その3 (少し長い）

;------------------------------------------------------

;選択したブロックのローカルファイル名を取得 GetSetBLK

;------------------------------------------------------

(defun GetSetBLK()

(if (= fSel 1)

(progn ;;ブロックが選択されている場合

(setq totalnum (* (- SECNUM 1) UNITAMU))

(setq totalnum (+ totalnum blknum))

(setq totalnum (- totalnum 1))

(setq SELBLK (nth totalnum dwglocal))

);progn



(progn ;;ブロックが選択されていない場合

(princ "\n ブロックが選択されていません。")

);progn

);if



);defun





;--------------------

;尺度の変更 CHScale

;--------------------

(defun CHScale()

(setq NumScale (get_tile "SList"))

(if (/= NumScale "0")

(progn

(setq StScale (nth (atoi NumScale) SList))

(setq ascale (substr StScale 3))

);progn

);if

);defun





;----------------------------

;ブロックの挿入 InsertBlock

;----------------------------

(defun InsertBlock()

(GetSetBLK) ;;選択したブロックのローカルファイル名を取得



(if (/= SELBLK NIL) ;;選択したブロックがNILでない場合

(progn

(setq exblkname (strcat BLOCKDIR "\\" SELBLK)) ;;外部ブロック名を取得（フルパス表示)



(setq inblkname SELBLK) ;;内部ブロック名を取得

(setq inlength (strlen inblkname))

(setq inlength (- inlength 4))

(setq inblkname (substr inblkname 1 inlength))



(if (tblsearch "block" inblkname) ;;内部ブロック名の確認

(setq INSNAME inblkname) ;;内部ブロックにある場合

(setq INSNAME exblkname) ;;内部ブロックにない場合

);if



(setq insx (atoi ascale)) ;;X方向の尺度を取得

(setq insy (atoi ascale)) ;;Y方向の尺度を取得



(command "_insert" INSNAME pause insx insy pause ) ;;insertコマンドを実行

;;最後に "" を書き加えるとBricscadがクラッシュする。

);progn

);if



);defun





;----------------------------

;直行モードの切替 OrthOnOff

;----------------------------

(defun OrthOnOff()

(cond

((= fOrth 1)

(setq fOrth 0)

(setvar "ORTHOMODE" 0);;直行モードをOFF

)

((= fOrth 0)

(setq fOrth 1)

(setvar "ORTHOMODE" 1);;直行モードをON

)

);cond

);defun





;----------------------------

;次の章へ NextSec

;----------------------------

(defun NextSec()

(setq SECNUM (1+ SECNUM))

(if (>= SECNUM SECLIMIT)

(setq SECNUM SECLIMIT)

);if

(SetBlockPath)

(setq blknum 0)

(setq fSel 0)

(setq SELBLK NIL)

);defun





;----------------------------

;前の章へ BackSec

;----------------------------

(defun BackSec()

(setq SECNUM (1- SECNUM))

(if (<SECNUM 1) (setq SECNUM 1)

);if

(SetBlockPath)

(setq blknum 0)

(setq fSel 0)

(setq SELBLK NIL)

);defun





;----------------------------

;終了 QuitLisp

;----------------------------

(defun QuitLisp()

(exit)

);defun