A図面に B図面の画層をコピー 寸法スタイルをコピー、コマンド2つで済むかと思いましたが、3つになってしまいそうです。
手順としては、B図面でコマンド1実行→A図面でコマンド2実行→B図面から全部の寸法スタイルオブジェクトをコピー→A図面でコマンド3実行
寸法でてこずっておりまして、とりあえず画層の設定まで。
念のため、A図面はバックアップを取ってから、ご使用ください。(B図面は変更しません。)
事前準備
※デスクトップにssetting.txtというテキストファイルを作っておいてください。
※コードの中の「名前」はご自分のユーザー名にしてください。(2か所あります)
※LISPのコードはメモ帳にコピーして、文字コードをANSIで保存してください。
※B図面の寸法スタイルと重複する寸法スタイル名に「XX-」を接頭辞として付加します。もし使用しているスタイルと重なる場合は、コードの中の「XX-」を任意のものに変更してください。
コマンド1 コマンド名:getdimlay
コマンド2 コマンド名:setdl
---------------------------------------
(defun C:getdimlay (/ path f lt lstr ssetting dimstr)
(setq path "C:/Users/名前/Desktop/ssetting.txt")
;前もってテキストファイル作成のこと
(setq f (open path "w"))
(setq lt (nth (getvar "MEASUREMENT") '("acad.lin" "acadiso.lin")))
(write-line lt f)
;線種名書き出し
(setq ssetting (tblnext "ltype" T))
(setq lstr (strcat "\"" (cdr (assoc 2 ssetting)) "\""));文字列化
(setq ssetting (tblnext "ltype"))
(while ssetting
(setq lstr (strcat lstr " " "\"" (cdr (assoc 2 ssetting)) "\""))
(setq ssetting (tblnext "ltype"))
)
(setq lstr (list lstr))
(princ lstr f)
(write-char 10 f)
;寸法スタイル名書き出し
(setq ssetting (tblnext "dimstyle" T))
(setq dimstr (strcat "\"" (cdr (assoc 2 ssetting)) "\""));文字列化
(setq ssetting (tblnext "dimstyle"))
(while ssetting
(setq dimstr (strcat dimstr " " "\"" (cdr (assoc 2 ssetting)) "\""))
(setq ssetting (tblnext "dimstyle"))
)
(setq dimstr (list dimstr))
(princ dimstr f)
(write-char 10 f)
;画層設定書き出し
(setq ssetting (tblnext "layer" T))
(while ssetting
(prin1 ssetting f);リストはwrite-lineで書き出しできない
(write-char 10 f);改行
(setq ssetting (tblnext "layer"))
)
(close f)
(princ "\n寸法スタイル名と画層設定を書き出しました。")
(princ)
)
;--------------------------------------------------------------------
(defun C:setdl (/ path f ssetting ltf lt cnt oname dimst ent llst headtxt)
(setq path "C:/Users/名前/Desktop/ssetting.txt")
(setq headtxt "XX-")
(setq f (open path "r"))
(command "cmdecho" "0")
(setq ltf (read-line f));1行目は線種定義ファイル名
(if (= ltf "acad.lin")
(setvar "MEASUREMENT" 0)
(setvar "MEASUREMENT" 1)
)
;線種ロード
(setq lt (read (read-line f)));2行目はロードする線種
(setq cnt 0)
(repeat (length lt)
(if (not (tblsearch "ltype" (nth cnt lt)))
(command "-linetype" "load" (nth cnt lt) ltf "")
)
(setq cnt (1+ cnt))
)
;重複する寸法スタイル名をリネーム(接頭辞XX-を付加)
(setq dimst (read (read-line f)));3行目は寸法スタイル名
(setq cnt 0)
(repeat (length dimst)
(if (tblsearch "dimstyle" (nth cnt dimst))
(command "-rename" "D" (nth cnt dimst) (strcat headtxt (nth cnt dimst)))
)
(setq cnt (1+ cnt))
)
;画層設定
(while (setq ssetting (read-line f))
(setq ssetting (read ssetting));readでリストとして読み込み
(setq oname (cdr (assoc 2 ssetting)))
(if (not (tblsearch "layer" oname))
(command "-layer" "N" oname "")
)
(setq cnt 2)
(setq ent (entget (tblobjname "layer" oname)))
(repeat (- (length ssetting) 2)
(setq llst (nth cnt ssetting))
(setq ent (subst llst (assoc (car llst) ent) ent))
(setq cnt (1+ cnt))
)
(entmod ent)
)
(close f)
(command "cmdecho" "1")
(princ "同一寸法名をRENAMEしました。\n画層の設定を適用しました。")
(princ)
)
----------------------------------------------------------------
- LUNE
- 2021/07/26 (Mon) 17:08:33