LUNE様
遅くなりました
以下Lisp内容です。
(defun c:DrowStart(/ SCALE LINEGAP TxtHeight DIMARROW selectAB selects ss1 ZS XY str_date point1 point2 MTxtHeight ename ss2 dict MLeaderDict MLeaderStyleObj CM DY VlObj XSNm OldSCALE CANNOSCALE DMObj MsObj MsNm ss_t ss_tm OLDTXT ss_BO ss_BI ss_ML ss_SyRE )
(MyerrorStart)
(setvar "MEASUREMENT" 1 );現在の図面で使用する線種ファイルを”メートル”に設定
(setvar "EXPERT" 3 );LINETYPE[線種設定]コマンドのプロンプト非表示
(setq OLDTXT (getvar "DIMTXT"));寸法文字高さ取得
;作成日取得
(setq str_date (rtos (getvar "CDATE")))
(setq str_date (strcat
(substr str_date 1 4) ; 西暦年
"/"
(substr str_date 5 2) ; 月
"/"
(substr str_date 7 2) ; 日
)
)
;;■図面サイズA1 or A2 選択
(setq selectAB (getstring "\nA1 《ESC》で終了\n[<A1>(A)/A2(B)] 《ESC》で終了 "))
;;■ファイル内図面複数枚or1枚選択
(setq selects (getstring "\n1枚の時 《ESC》で終了\n[<1枚>(C)/複数枚(D)] 《ESC》で終了 "))
;;■尺度選択
(setq SCALE (getstring "新規設定する尺度(使用可能尺度:1,2,2.5,3,4,5,6,7.5,10,15,20,25,30,40,50,60,75,80,100,125,150,200)→1/")) ; 新規尺度を入力
;(scalesettei)
(setq DN (strcat "ACM-" SCALE));寸法スタイル用に文字列結合
(setq ZS (strcat "1/" SCALE));図面尺度用に文字列結合
(DstyleNew DN);尺度に合せた新規寸法スタイル名作成
;;■図面サイズ別文字高さ・線種尺度など各既定値設定
(DIMTHLTS)
;;■対象オブジェクト選択
(setq point1 (getpoint "対象となるオブジェクトを含んだ対角1点目を指示"))
(setq point2 (getcorner point1 "\n対象となるオブジェクトを含んだ対角2点目を指示"))
(setq ss1 (ssget "w" point1 point2 ))
;;■図面枠表題の尺度、作図日、製図者名書換え
(command "-attedit" "y" "*" "図面尺度" "*" "w" point1 point2 "v" "r" ZS "" );表題の尺度を新規尺度に書換え
(command "_attedit" "y" "*" "作図開始日" "*" "w" point1 point2 "v" "r" str_date "" )
;;■ファイル内図面複数枚or1枚選択 C＝1枚
(if (= selects "C" );ファイル内に図面１枚の時
(progn
(setvar "LTSCALE" LINEGAP );線種尺度を尺度に合わせて設定
(setq OldSCALE (getvar "CANNOSCALE"));現在の注釈尺度取得
(setvar "CANNOSCALE" SCALE);新しい注釈尺度を設定
);progn
(progn;複数枚の時
(setq OldSCALE (getvar "DIMSCALE"));現在の注釈尺度取得
(setq OldSCALE (getstring (strcat "変更前の尺度⇒ 1/"(rtos OldSCALE)" ？ ※必ず実数を手入力してください:"))) ;
(command "-OBJECTSCALE" ss1 "" "a" SCALE "");異尺度対応オブジェクトに新しい異尺度を追加
);progn
);if
;;■以下から共通
(DTMBchange);;■ダイナミック文字・マルチテキスト・マルチ引出線・シンボルブロック・スタンダード文字基本設定 尺度に合せて変更
(MLstandard);;■マルチ引出線スタイル"standard"をアクティブ図面の尺度に合せて高さ、全体尺度を変更
(setvar "DIMSCALE" (atof SCALE));寸法の全体尺度を変更 atof：文字列を実数に変換
(command "DIMTXT" TxtHeight);寸法文字高さを尺度に合わせて設定
(command "DIMASZ" DIMARROW);寸法・引出線矢印サイズを尺度に合わせて設定
(command "-DIMSTYLE" "s" DN "y" );寸法スタイル(ACM-●)に登録
(command "-DIMSTYLE" "a" ss1 "" );登録したスタイルを寸法に適用させる
(command "mleaderscale" SCALE );アクティブ図面のマルチ引出線尺度の変更 マルチ引出線スタイル”standard”
(command "_dimdisassociate" "all" "" );自動調整寸法解除
(command "_LINETYPE" "L" "*" "acadiso" "");全線種再読み込み
(command "REGEN" )
;;■余分な注釈尺度を削除
(if (= selects "C" );ファイル内に図面１枚の時
(command "-OBJECTSCALE" ss1 "" "d" OldSCALE "");余分な注釈尺度を削除
(command "-OBJECTSCALE" ss1 "" "d" OldSCALE "?" );余分な注釈尺度を削除
);if
(MyerrorEND)
(princ )
)
(defun MstyleHeight_DIMScale (DN )
(if (null (tblsearch "style" DN ))
(command-s "._STYLE"
DN ;文字スタイル名
"simplex8.shx,extfont2.shx" ;フォント名
(* TxtHeight (atof SCALE)) ;文字高さ
"0.9" ;幅係数
"0" ;傾斜角度
"N" ;左右反転
"N" ;上下反転
"N" ;縦書き
) ;command-s
);if
(princ));defun
(defun DTMBchange (/ )
;;■図面内既存ダイナミック・マルチ文字を尺度に合せて変更、新規尺度で文字スタイル作成
(vl-load-com)
(MstyleHeight_DIMScale DN);新規尺度での文字スタイル無かったら作成、あればスルー
(setvar "TEXTSTYLE" DN);新規尺度での文字スタイルを現在に設定
;;■既存文字を新規文字スタイルへ
(princ"\n既存文字を新規文字スタイルへ《ESC》で終了")
(setq ss2 (ssget "w" point1 point2))
(command "pselect" ss2 "" )
(setq ss_tm (ssget "_P" '((0 . "TEXT,MTEXT"))))
(command "pselect" ss2 "" )
(setq ss_t (ssget "_P" '((0 . "TEXT"))))
(command "pselect" ss2 "" )
(setq ss_BO (ssget "_P" '((2 . "オリエンテーションNo"))))
(command "pselect" ss2 "" )
(setq ss_BI (ssget "_P" '((2 . "相番3文字以上の時"))))
(command "pselect" ss2 "" )
(setq ss_ML (ssget "_P" '((0 . "*LEADER"))))
(command "pselect" ss2 "" )
(setq ss_SyRE (ssget "_P" '((8 . "Symbol,REVISION"))))
(setq i 0)
(if ss_tm;ダイナミックテキスト・マルチテキスト 異尺度対応・異尺度未対応両方に対応
(repeat (sslength ss_tm)
(setq ename (ssname ss_tm i))
(setq i (1+ i))
(vla-put-Layer (vlax-ename->vla-object ename) "MOJI")
(setq DMObj (vlax-ename->vla-object ename));現在設定されている文字高さを取得する前準備
(setq DMHeight (vla-get-Height DMObj));現在設定されているHeightを取得
(cond
((= OLDTXT (/ DMHeight (atof OldSCALE))) (setq NewTxtheight OLDTXT))
(T (setq NewTxtheight (/ DMHeight (atof OldSCALE))))
);cond
(command "_SCALETEXT" ename "" "e" (* (atof SCALE) NewTxtheight));ダイナミック文字高さ変更
(command "_SCALETEXT" ename "" "e" "p" NewTxtheight);マルチテキスト文字高さ変更
)
)
(setq i 0)
(if ss_t;ダイナミックテキスト 異尺度対応・異尺度未対応両方に対応
(repeat (sslength ss_t)
(setq ename (ssname ss_t i))
(setq i (1+ i))
(vla-put-ScaleFactor (vlax-ename->vla-object ename) 0.9)
)
);if
(setq i 0)
(if ss_BO;ブロック オリエンテーションNo 尺度に合せて変更
(repeat (sslength ss_BO)
(setq ename (ssname ss_BO i))
(setq i (1+ i))
(vla-put-XScaleFactor (vlax-ename->vla-object ename) SCALE)
);if
)
(setq i 0)
(if ss_BI;ブロック 相番 3文字以上 尺度に合せて変更
(repeat (sslength ss_BI)
(setq ename (ssname ss_BI i))
(setq i (1+ i))
(vla-put-XScaleFactor (vlax-ename->vla-object ename) (* (atof SCALE) 1.2))
);if
)
(setq i 0);図面内既存マルチ引出線文字を尺度に合せて高さ、全体尺度を変更 異尺度未対応
(if ss_ML
(repeat (sslength ss_ML)
(setq ename (ssname ss_ML i))
(setq i (1+ i))
(if (/= 1 (cdr (assoc 293 (reverse (entget ename)))))
(progn
(vla-put-ArrowheadSize (vlax-ename->vla-object ename) DIMARROW)
(vla-put-ScaleFactor (vlax-ename->vla-object ename) (atof SCALE))
(vla-put-TextHeight (vlax-ename->vla-object ename) TxtHeight)
(vla-put-Layer (vlax-ename->vla-object ename) "MOJI")
);progn
);if
);repeat
);if
(setq i 0);画層"Symbol""REVISION"をアクティブ図面の尺度に合せて尺度を変更
(if ss_SyRE
(repeat (sslength ss_SyRE)
(setq ename (ssname ss_SyRE i))
(setq i (1+ i))
(setq VlObj (vlax-ename->vla-object ename));現在のXScaleを取得する前準備
(setq XSNm (vla-get-XScaleFactor VlObj));現在のXScaleを取得
(vla-put-XScaleFactor (vlax-ename->vla-object ename) (* XSNm (/ (atof SCALE) (atof OldSCALE))));新規尺度のXScaleに変更
)
)
(princ )
)
(defun MLstandard (/ )
;;■マルチ引出線スタイル"standard"をアクティブ図面の尺度に合せて高さ、全体尺度を変更
(vl-load-com)
(vlax-for dict (vla-get-dictionaries (vla-get-activedocument (vlax-get-acad-object)))
(if (and (vlax-property-available-p dict 'name)
(= (vla-get-name dict) "ACAD_MLEADERSTYLE")
)
(setq MLeaderDict dict)))
;名前が"Standard"であるMLeaderStyleを取得
(vlax-for itm MLeaderDict
(if (= (vla-get-name itm) "Standard")
(setq MLeaderStyleObj itm)))
;引出線スタイル "standard" の全体尺度と文字高さ尺度に合せて変更
(if MLeaderStyleObj
(progn
;矢印のサイズ（Z)
(vla-put-ArrowSize MLeaderStyleObj DIMARROW)
;尺度（E)
(vla-put-ScaleFactor MLeaderStyleObj SCALE)
;文字の高さ
(vla-put-TextHeight MLeaderStyleObj MTxtHeight)
)
)
(princ )
)