画層のコピー
2007/7/10 火曜日 - 19:04:08 by 後藤
図面中に存在する画層を別名でコピーするというのが必要になって調べてみた。tblsearch と (command “layer” ・・・・)では画層の設定内容をそのまま引き継ぐのは難しい。ということで、tblobjname を使ってみることにした。できたのがこれ。いつもネットで有用な情報をもらっているので、たまには私からもコードを公開します。
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;引数： lay1 : 元画層名
; lay2 : コピー先画層名
;
;Return： 作成されたエンティティ:成功
; nil:失敗
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun COPY_LAY ( lay1 lay2 / tbl ent nn buff1 buff2 ret )
;;; 画層の有無
(if (not (setq tbl (tblobjname “LAYER” lay1)))(progn
(princ (strcat “\n画層＜” lay1 “＞は存在しません。”))
(exit)
))
(setq ent (entget tbl))
;;; エンティティから図形名と図形ハンドルを削除
(foreach nn (list -1 330 5 390)
(setq ent (vl-remove (assoc nn ent) ent))
)
;;; コピー先画層がない場合、コピー画層の作成
(if (not (tblsearch “LAYER” lay2))(progn
(setq buff1 (assoc 2 ent))
(setq buff2 (cons 2 lay2))
(setq ent (subst buff2 buff1 ent))
;;; 画層作成
(setq ret (entmake ent))
))
ret
)