==================================================発行部数919======
AutoCADカスタマイズ入門講座 No.17 1999/08/29
===================================================================
AutoCADカスタマイズ入門講座のご購読ありがとうございます。
まだまだ暑い日が続きますが、みなさんいかがお過ごしでしょうか？。しか
し夜になると虫たちの鳴声が聞こえるようになり、秋ももうそこまで来てい
る様です。今回はCHANGEコマンドのもう一つのオプション、変更位置を指示
オプションを作成していきます。
--------------------------------------------------------------------
１．変更位置を指示オプション
--------------------------------------------------------------------
変更位置を指示オプションは、ユーザリファレンスを見て頂ければわかる
様に、変更点を指示する事により、線分、円、複合図形、文字、属性定義の
各特性を変更する事ができます。今回はこの中から線分の変更を行うプログ
ラムを取り上げます。線分（LINE）に対して変更位置を指示オプションを適
用した場合は、指示した点に近い方の線分の端点が指示した点に変更されま
す。今回はこのプログラムを作成していきます。
まず、前回まで作成してきたmchange.lspの(mychange)関数を関数を変更
します。ここでは、(propchange)関数と同様に(locatechange)関数にも引数
として変数ret及びss1を渡します。ただし、(mychange)関数で
(locatechange)関数が呼ばれる時には、retには点(x y z)を示す座標が入っ
ている事に注意してください。
; -----------------------------
; mychange コマンドメイン関数
; -----------------------------
(defun C:mychange()
(setq ss1 (getobj)) ; 変更するエンティティを選択する
(setq ret (getctype)) ; オプションを選択する
; オプションにより処理を分岐させる
(if (= (type ret) 'STR)
(propchange ret ss1 ) ; 特性変更オプション
(locatechange ret ss1 ) ; 変更位置オプション
)
)
次に(locatechange)関数本体を変更します。
以下に(locatechange)関数を示します。処理の内容はコメントを見て頂けれ
ば大体わかると思います。(distance)関数は2点間の距離を求める関数で、
書式は(distance 点1 点2）です。この関数を用いて、変更位置と線分の各
端点の距離を求め近いほうの端点を変更位置で指定した点に変更しています
。また、エンティティが"LINE"の時のみ処理が行われるように、処理を(if)
で囲んであります。
;----------------------------
; 変更位置オプション関数
;----------------------------
;(defun locatechange( ret ss1 / ename i p1 tmp1 )
(defun locatechange( ret ss1 )
(setq i 0)
(while (if (setq ename (ssname ss1 i)) /= nil)
(setq tmp1 (cdr (getprop ename 0)))
(if (= tmp1 "LINE")
(progn
; 線分の始点、終点の座標を得る
(setq p1 (cdr (getprop ename 10)))
(setq p2 (cdr (getprop ename 11)))
; 変更位置と始点、終点の距離を求める
(setq dist1 (distance p1 ret))
(setq dist2 (distance p2 ret))
; 変更位置と線分のどちらの端点が近いかを求めて
; 近いほうの端点を変更位置へ変更する
(if (< dist1 dist2)
(progn
(setq newp (list 10 (car ret) (cadr ret) (last ret)))
(setq tmp (setprop ename newp))
(entmod tmp)
)
(progn
(setq newp (list 11 (car ret) (cadr ret) (last ret)))
(setq tmp (setprop ename newp))
(entmod tmp)
)
)
)
)
(setq i (+ i 1))
)
)
--------------------------------------------------------------------
２．プログラムリスト
--------------------------------------------------------------------
では、最後に完成したプログラムのリストを示します。
;------------------------------------------------------------------
; mychangeコマンドの制限事項
; 1. 色変更オプションで色は色番号で与える必要があります。
; 2. 線種変更オプションでは変更する線種が既に登録されている必要があ
; ります。
;------------------------------------------------------------------
; -----------------------------
; mychange コマンドメイン関数
; -----------------------------
(defun C:mychange()
(setq ss1 (getobj)) ; 変更するエンティティを選択する
(setq ret (getctype)) ; オプションを選択する
; オプションにより処理を分岐させる
(if (= (type ret) 'STR)
(propchange ret ss1 ) ; 特性変更オプション
(locatechange ret ss1 ) ; 変更位置オプション
)
)
; ----------------------------
; エンティティ選択関数
;-----------------------------
(defun getobj()
(ssget)
)
;-----------------------------
; オプション選択関数
;-----------------------------
(defun getctype( / flag ret )
(setq flag 1)
(while flag
(progn
(initget 128 "Prop") ;(getxxx)関数で任意入力を許します
(setq ret (getpoint "P=特性/<変更位置を指示>:"))
(if (and (= (type ret) 'STR)(= ret "Prop"))
(progn
(initget 1 "Color hEight LAyer LType Thick")
(setq ret (getkword "変更する特性 (C=色/E=高度/LA=画層/LT=線種/T=厚さ) ?"))
(setq flag nil)
)
)
(if (= (type ret) 'LIST) (setq flag nil))
)
)
(setq ret ret)
)
; ---------------------------
; 特性変更オプション関数
;----------------------------
(defun propchange( option ss1 )
(if (= option "Color") ;色変更
(colorchange ss1 )
)
(if (= option "hEight") ;高度変更
(heightchange ss1)
)
(if (= option "LAyer") ;画層変更
(layerchange ss1 )
)
(if (= option "LType") ;線種変更
(ltypechange ss1 )
)
(if (= option "Thick") ;厚さ変更
(thickchange ss1 )
)
(setq a nil)
)
;----------------------------
; 変更位置オプション関数
;----------------------------
(defun locatechange( ret ss1 / ename i p1 p2 tmp1 dist1 dist2 newp tmp)
;(defun locatechange( ret ss1 )
(setq i 0)
(while (if (setq ename (ssname ss1 i)) /= nil)
(setq tmp1 (cdr (getprop ename 0)))
(if (= tmp1 "LINE")
(progn
; 線分の始点、終点の座標を得る
(setq p1 (cdr (getprop ename 10)))
(setq p2 (cdr (getprop ename 11)))
; 変更位置と始点、終点の距離を求める
(setq dist1 (abs (distance p1 ret)))
(setq dist2 (abs (distance p2 ret)))
; 変更位置と線分のどちらの端点が近いかを求めて
; 近いほうの端点を変更位置へ変更する
(if (< dist1 dist2)
(progn
(setq newp (list 10 (car ret) (cadr ret) (last ret)))
(setq tmp (setprop ename newp))
(entmod tmp)
)
(progn
(setq newp (list 11 (car ret) (cadr ret) (last ret)))
(setq tmp (setprop ename newp))
(entmod tmp)
)
)
)
)
(setq i (+ i 1))
)
)
;---------------------------
; 色変更関数
;---------------------------
;(defun colorchange( ss1 )
(defun colorchange( ss1 / i flag tmp1 tmp2 elist )
(setq i 0) (setq flag 0)
(setq tmp1 nil) (setq tmp2 nil)
; 現在の属性を調べる
(while (if (setq ename (ssname ss1 i)) /= nil)
(setq tmp1 (cdr (getprop ename 62)))
(if (and (/= tmp1 tmp2) (/= tmp2 nil))
(progn
(setq flag 1)
)
)
(setq tmp2 tmp1)
(setq i (+ i 1))
)
; 選択したエンティティ内に2色以上の色属性がある場合
(if (= flag 1)
(progn
(setq newc (getstring "新しい色<既定値>:"))
)
)
; 選択した全エンティティに色属性が付加されていない場合
(if (and (= flag 0) (= tmp1 nil))
(progn
(setq newc (getstring "新しい色<BYLAYER>:"))
)
)
; 選択した全エンティティが同一の色属性を持つ場合
(if (and (= flag 0) (/= tmp1 nil))
(progn
(princ "新しい色<")(princ tmp1)
(setq newc (getstring ">:"))
)
)
; 属性を変更する
(setq i 0)
(if (and (/= newc nil) (/= newc ""))
(progn
(while (if (setq ename (ssname ss1 i)) = nil)
(setq elist (entget ename))
(setq tmp2 (cons 62 (atoi newc)))
(setq tmp1 (list tmp2))
(setq tmp2 (append elist tmp1))
(entmod tmp2)
(setq i (+ i 1))
)
)
)
)
;---------------------------
; 高度変更関数
;---------------------------
(defun heightchange( ss1 / i flag tmp1 tmp2 elist )
;(defun heightchange( ss1 )
(setq i 0) (setq flag 0)
(setq tmp1 0.0) (setq tmp2 nil)
; 現在の属性を調べる
(while (if (setq ename (ssname ss1 i)) /= nil)
(setq list10 (getprop ename 10))
(setq list11 (getprop ename 11))
(setq tmp1 (cadddr list10))
(if (and (/= tmp1 tmp2) (/= tmp2 nil))
(progn
(setq flag 1)
)
)
(setq tmp2 tmp1)
(setq i (+ i 1))
)
; 選択したエンティティ内に2つ以上の高度属性がある場合
(if (= flag 1)
(progn
(setq newc (getstring "新しい高度<既定値>:"))
)
)
; 選択した全エンティティに高度属性が付加されていない(つまり0.0)場合
(if (and (= flag 0) (= tmp1 nil))
(progn
(setq newc (getstring "新しい高度<0.0>:"))
)
)
; 選択した全エンティティが同一の高度属性を持つ場合
(if (and (= flag 0) (/= tmp1 nil))
(progn
(princ "新しい高度<")(princ tmp1)
(setq newc (getstring ">:"))
)
)
; 属性を変更する
(setq i 0)
(if (and (/= newc nil) (/= newc ""))
(progn
(while (if (setq ename (ssname ss1 i)) = nil)
(setq list10 (getprop ename 10))
(setq list11 (getprop ename 11))
(setq tmp1 (list 10 (cadr list10) (caddr list10) (atof newc)))
(setq tmp2 (list 11 (cadr list11) (caddr list11) (atof newc)))
(setq tmp (setprop ename tmp1))
(entmod tmp)
(setq tmp (setprop ename tmp2))
(entmod tmp)
(setq i (+ i 1))
)
)
)
)
;---------------------------
; 画層変更関数
;---------------------------
(defun layerchange( ss1 / i flag tmp1 tmp2 elist )
;(defun layerchange( ss1 )
(setq i 0) (setq flag 0)
(setq tmp1 nil) (setq tmp2 nil)
; 現在の属性を調べる
(while (if (setq ename (ssname ss1 i)) /= nil)
(setq tmp1 (cdr (getprop ename 8)))
(if (and (/= tmp1 tmp2) (/= tmp2 nil))
(progn
(setq flag 1)
)
)
(setq tmp2 tmp1)
(setq i (+ i 1))
)
; 選択したエンティティ内に2つ以上の画層属性がある場合
(if (= flag 1)
(progn
(setq newc (getstring "新しい画層<既定値>:"))
)
)
; 選択した全エンティティに画層属性が付加されていない場合
(if (and (= flag 0) (= tmp1 nil))
(progn
(setq newc (getstring "新しい画層<BYLAYER>:"))
)
)
; 選択した全エンティティが同一の画層属性を持つ場合
(if (and (= flag 0) (/= tmp1 nil))
(progn
(princ "新しい画層<")(princ tmp1)
(setq newc (getstring ">:"))
)
)
; 属性を変更する
(setq i 0)
(if (and (/= newc nil) (/= newc ""))
(progn
(while (if (setq ename (ssname ss1 i)) = nil)
(setq elist (entget ename))
(setq tmp2 (cons 8 newc))
(setq tmp1 (list tmp2))
(setq tmp2 (append elist tmp1))
(entmod tmp2)
(setq i (+ i 1))
)
)
)
)
;---------------------------
; 線種変更関数
;---------------------------
(defun ltypechange( ss1 / i flag tmp1 tmp2 elist )
(setq i 0) (setq flag 0)
(setq tmp1 nil) (setq tmp2 0)
; 現在の属性を調べる
(while (if (setq ename (ssname ss1 i)) /= nil)
(setq tmp1 (cdr (getprop ename 6)))
(if (and (/= tmp1 tmp2) (/= tmp2 0))
(progn
(setq flag 1)
)
)
(setq tmp2 tmp1)
(setq i (+ i 1))
)
; 選択したエンティティ内に2つ以上の線種属性がある場合
(if (= flag 1)
(progn
(setq newc (getstring "新しい線種<既定値>:"))
)
)
; 選択した全エンティティに線種属性が付加されていない場合
(if (and (= flag 0) (= tmp1 nil))
(progn
(setq newc (getstring "新しい線種<BYLAYER>:"))
)
)
; 選択した全エンティティが同一の線種属性を持つ場合
(if (and (= flag 0) (/= tmp1 nil))
(progn
(princ "新しい線種<")(princ tmp1)
(setq newc (getstring ">:"))
)
)
; 属性を変更する
(setq i 0)
(if (and (/= newc nil) (/= newc ""))
(progn
(while (if (setq ename (ssname ss1 i)) = nil)
(setq elist (entget ename))
(setq tmp2 (cons 6 newc))
(setq tmp1 (list tmp2))
(setq tmp2 (append elist tmp1))
(entmod tmp2)
(setq i (+ i 1))
)
)
)
)
;---------------------------
; 厚さ変更関数
;---------------------------
(defun thickchange( ss1 / i flag tmp1 tmp2 elist )
(setq i 0) (setq flag 0)
(setq tmp1 nil) (setq tmp2 nil)
; 現在の属性を調べる
(while (if (setq ename (ssname ss1 i)) /= nil)
(setq tmp1 (cdr (getprop ename 39)))
(if (and (/= tmp1 tmp2) (/= tmp2 nil))
(progn
(setq flag 1)
)
)
(setq tmp2 tmp1)
(setq i (+ i 1))
)
; 選択したエンティティ内に2つ以上の厚さ属性がある場合
(if (= flag 1)
(progn
(setq newc (getstring "新しい厚さ<既定値>:"))
)
)
; 選択した全エンティティに厚さ属性が付加されていない場合
(if (and (= flag 0) (= tmp1 nil))
(progn
(setq newc (getstring "新しい厚さ<0.0>:"))
)
)
; 選択した全エンティティが同一の厚さ属性を持つ場合
(if (and (= flag 0) (/= tmp1 nil))
(progn
(princ "新しい厚さ<")(princ tmp1)
(setq newc (getstring ">:"))
)
)
; 属性を変更する
(setq i 0)
(if (and (/= newc nil) (/= newc ""))
(progn
(while (if (setq ename (ssname ss1 i)) = nil)
(setq elist (entget ename))
(setq tmp2 (cons 39 (atof newc)))
(setq tmp1 (list tmp2))
(setq tmp2 (append elist tmp1))
(entmod tmp2)
(setq i (+ i 1))
)
)
)
)
;---------------------------
; 属性取得関数
;---------------------------
(defun getprop(entname grpcode / elist)
(setq elist (entget entname))
(assoc grpcode elist)
)
;---------------------------
; 属性設定関数
;---------------------------
(defun setprop(entname grplist / elist grpcode olidlist elist2 )
(setq elist (entget entname))
(setq grpcode (car grplist))
(setq oldlist (assoc grpcode elist))
(setq elist2 (subst grplist oldlist elist))
)
--------------------------------------------------------------------
３．最後に
--------------------------------------------------------------------
今回でCHANGEコマンドライクなMYCHANGEコマンドの作成は終わりです。い
かがでしたでしょうか？。まったく同じというわけにはいきませんでしたが
、まぁ、それらしいコマンドは出来たのではないでしょうか。また、AutoCA
Dのデータの構成を学には良い例題だったと思いす。
ここまで学んでこられた皆さんは、既に基本的なエンティティの作成や変
更などはマスターされたのではないかと思います。後は自分に適したプログ
ラムを作成するだけです。
次回からはもう少し実務に役立つようなプログラムを作成していきたいと
思います。また、ここ数回メールの行数が多くなってしまっているのでもう
少しコンパクトな内容にしたいと思います。
ご意見、ご感想などがございましたら以下のメールアドレスまでお願いし
ます。また、「こんなプログラムが作りたい．．．」などの要望がございま
したら同様にメールを頂ければ幸いです(なかなかいい例題プログラムのア
イディアが浮かばないので．．．)。よろしくお願いします。
●バックナンバーは下記のURLで参照する事が出来ます。
http://www2u.biglobe.ne.jp/~Saturn5/alisp.htm
====================================================================
■登録／解除の方法
http://www2u.biglobe.ne.jp/~Saturn5/alisp.htm
「ＡｕｔｏＣＡＤカスタマイズ入門講座」は、上記ＵＲＬよりいつでも
登録／解除可能です。
====================================================================
●広告の問い合わせ
広告のお問い合わせは以下のメールアドレスへお願いします。
wankichi@mba.nifty.ne.jp
====================================================================
■「ＡｕｔｏＣＡＤカスタマイズ入門講座」No.17
発行責任者 ：わんきち（wankichi@mba.nifty.ne.jp)
発行システム：インターネットの本屋さん『まぐまぐ』
http://www.mag2.com/
マガジンＩＤ：0000011579
====================================================================
戻る