AutoCADマクロ屋本舗 掲示板


画層 寸法スタイルコピー

1:かい :

2021/07/21 (Wed) 08:36:09

autocad2014をつかっています。

A図面に B図面の画層をコピー 寸法スタイルをコピー(できれば上書き)

をマクロかLISPを使ってできるのでしょうか?
2:chibi-tom :

2021/07/21 (Wed) 09:10:22

>できれば上書き
を考えると逆にすれば良いのでは?

自分ならB図面を全削除してまたはB図面のテンプレートを用意して
A図面のオブジェクトをすべてコピーします

それで良ければマクロやLISPにするほどでもない気がしますが
3:かい :

2021/07/21 (Wed) 09:37:08

わたしもそれを考えたのですが、あまり詳しくなくて

例えばA図面のオブジェクトをすべてコピーするときロックされている画層のオブジェクトや
非表示になっているオブジェクトなどもすべてコピーされるのでしょうか?

A図面は複数のパターンがあり非表示になっている画層はそれぞれ異なります。

レイアウトも使用しているのでその作業も増えてしまいます。
B図面のテンプレートにA図面をコピーすると名前を付けて保存する処理も増えます。

たぶんこれぐらいの処理は必要になるかなと想像していたら頭がパニックになってきます。
結果 あの質問になりました。
4:chibi-tom :

2021/07/21 (Wed) 09:40:58

なんとなくわかりましたがちょっとマクロでは難しそうです
LISPも全く分からないので自分は退散いたします
失礼いたしました
5:かい :

2021/07/21 (Wed) 09:54:30

ありがとうございました。

(たぶん寸法スタイル上書きがネックなんですよね?)
6:chibi-tom :

2021/07/21 (Wed) 10:15:36

寸法スタイルだけではないと思います
『上書き』がネックになるかと

画層名もコピー先に同じ名前が存在すればコピー先の設定となり
通常は上書きされることは無いと思います
7:Lon :

2021/07/21 (Wed) 11:11:42

やった訳じゃないので出来ないかもしれませんが、
こんなの試してみては?

①A図面をB図面にブロック挿入。(B図面を開いてA図面をドラッグ&ドロップ)
②WBLOCKコマンドでそのA図面ブロックを書き出し。
③レイアウトをデザインセンターかLAYOUTコマンドで書き出した図面にコピー
④画層の表示・非表示の復元。(元の図面から画層状態を書き出して新しい図面上で復元)

どうでしょ?

お手軽ワンクリックとはいきませんけど。コピペより少しは楽かな?同じかな?

8:Lon :

2021/07/21 (Wed) 11:15:23

上の方法で注意! 
同名で異形状のブロックが有ればこの方法は無理。
コピペの方法でも無理。

寸法スタイルと画層の設定を何かしらの方法で元図面から書き出して、
何かしらの方法で相手側図面に設定する方法が必要です。
9:かい :

2021/07/21 (Wed) 12:04:33

ありがとうございます。
難しそうですね

なにか元からできないことを求めているような気がします。
(できそうでできない  汗 )
10:LUNE :

2021/07/21 (Wed) 13:17:54

Lispでも、ファイルをまたいでの操作は難しいですね。
画層の場合は、A図面の画層にすべて同じ接頭辞をつけてrenameしてから、B図面の画層を挿入し、laymergeで合成すればなんとかなりそうな気がしますが・・・

もし、Lispで行う場合は、2つのコマンドに分かれると思いますが、それでもよければお時間いただければチャレンジしてみます。
B図面で画層設定および寸法スタイル設定を読み込むコマンドと、A図面の設定を変更するコマンドになると思います。
11:とってぃ :

2021/07/21 (Wed) 14:52:03

寸法スタイルは、B図面で書いた寸法をコピーし
A図面に貼り付けすればできますよね。
12:かい :

2021/07/21 (Wed) 16:35:44

みなさんありがとうございます。

すごい簡単に考えていましたがやはり上書きがネックなんですね。

お時間があればよろしくお願いします。
13:LUNE :

2021/07/26 (Mon) 17:08:33

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)

)

----------------------------------------------------------------
14:LUNE :

2021/07/27 (Tue) 13:48:33

寸法スタイル変更用です。

B図面でコマンド1実行→A図面でコマンド2実行→B図面から全部の寸法スタイルオブジェクトをコピー→A図面でコマンド3実行
実行前に、B図面から全部の寸法スタイルオブジェクトをコピー、もしくはデザインセンターを経由してB図面の寸法スタイルをA図面に移してください。

前回のコマンドで、接頭辞を「XX-」をから変更した場合は、コードの中の「XX-」を変更してください。

コマンド3 コマンド名:setdim
-------------------------------------------------------------
(defun C:setdim (/ ss ent headtxt dimst cnt lst)
(setq headtxt "XX-")

;寸法スタイル検索
(setq ssetting (tblnext "dimstyle" T))

(while ssetting
(setq dimst (cdr (assoc 2 ssetting)))
(if (wcmatch dimst (strcat headtxt "*")) ;接頭辞付スタイルのみ処理
(progn
;接頭辞有寸法スタイルをもつオブジェクト→接頭辞なしの寸法スタイルにする
(setq ss (ssget "X" (list (cons 3 dimst))))
(setq dimst (substr dimst 4))
(setq cnt 0)
(repeat (sslength ss)
  (setq ent (entget (ssname ss cnt)))
  (setq ent (subst (cons 3 dimst) (assoc 3 ent) ent))
  (entmod ent)
  (setq cnt (1+ cnt))
)
)
)
(setq ssetting (tblnext "dimstyle"))
(command "-purge" "D" (strcat headtxt dimst) "N")
)
(princ)
)
-------------------------------------------------------------

  • 名前: E-mail(省略可):
  • 画像:

Copyright © 1999- FC2, inc All Rights Reserved.