[AutoCAD VBA] 線分の中央に長さを配置する（下水道

図-2 人により違うかもしれませんが、平面図を描くときは、マンホールの丸を描いて、それを結ぶ線分を引きます， "##0.00") "m"' 線分の角度を取得dblAngle = ReturnObject.Angle' プロンプトにて延長と角度の確認ThisDrawing.Utility.Prompt _"延長＝" strLength _ "/ 角度＝" dblAngle "Radian" vbCrLf' 線分の始点と終点の取得StartPoint = ReturnObject.StartPointEndPoint = ReturnObject.EndPoint' 文字の挿入ポイントを計算（始点と終点の中間点）InsPoint(0) = (StartPoint(0) + EndPoint(0)) / 2InsPoint(1) = (StartPoint(1) + EndPoint(1)) / 2InsPoint(2) = (StartPoint(2) + EndPoint(2)) / 2' 文字を生成（内容，言わずもがなですが、図-1のようにするにはこの丸で線分をトリムします。

ここで実行。

今回はこの 延長暗示を手軽に作成できるマクロ を組んでみました， _ InsPoint， 図-1 ◎暗示は組立1号マンホールです， BasePoint， 下水道の平面線形は概ね図-1のような感じです，www.53d.org， _"線分を選択して下さい / Cancel=ESC"' 選択オブジェクトが「線分」なら処理If ReturnObject.ObjectName = "AcDbLine" Then' 延長(mm)を(ｍ)に変換LengthMeter = ReturnObject.Length / 1000' 延長文字列を整形strLength = "L=" Format(LengthMeter， 挿入座標，上図にはありませんが、実際には線の端点に丸があると思って下さい，。

実際のところ平面図・縦断図は専用ソフトを使ってCAD生成することが多いのですが、系統図の作成などで使えるのかなと思っています。

StartPointとEndPointはVariant型で取得、AddTextメソッドで使う挿入点（InsertionPoint）は、XYZ各数値を入力するためバラバラにDouble型で設定するところです， 線分を選択（GetEntityメソッド） 長さと角度を取得（Lengthプロパティ、Angleプロパティ） 線分の始点と終点の座標を取得（StartPointプロパティ、EndPointプロパティ） 線分の中点の座標を計算 延長を整形して中点を基点として文字を作図（AddTextメソッド） 文字を線分の角度に合わせて回転する 文字の基点を下中心にする 文字の基点座標を改めて線分の中点座標にする 文字オブジェクトの暗示を更新 となります，superrecovery，図-1でいうと L=12.00m などと記入している部门です， このような結果となります， Option ExplicitPublic Sub LineLongText()start:Dim ReturnObject As AcadEntityDim BasePoint As VariantDim StartPoint As VariantDim EndPoint As VariantDim InsPoint(0 To 2) As DoubleDim Height As SingleDim LengthMeter As DoubleDim strLength As StringDim dblAngle As DoubleDim objTxt As AcadEntity' Null/0/マイナス値を入力できないようにするCall ThisDrawing.Utility.InitializeUserInput(1 + 2 + 4)' 文字高さを実数入力Height = ThisDrawing.Utility.GetReal("文字高さを入力：")main:' エラー処理On Error GoTo ersub' オブジェクトの選択：GetEntityメソッドThisDrawing.Utility.GetEntity ReturnObject， 実際のコーディングは以下のようになります， Height)' 文字の角度を設定objTxt.Rotation = dblAngle' 文字の基点を「下中心」に設定objTxt.Alignment = acAlignmentBottomCenter' 文字の基点座標を挿入ポイントに改めて設定objTxt.TextAlignmentPoint = InsPoint' 文字オブジェクトを更新objTxt.Update' 線分選択に戻るGoTo mainElse' エラー処理：線分じゃなかったら警告を出して線分選択に戻るMsgBox "これは線分ではありません， 文字高さを入力してから、線分を選択 延長がセットされました，線分オブジェクトには長さや角度のプロパティがありますので、これらを使って文字をおいていくことにしました， ，"GoTo mainEnd IfExit Subersub:' エラー処理 Err.Clear ThisDrawing.Utility.Prompt "エラー：コマンドを終了します，選択し直して下さい， さて、せっかくAutoCADで実寸で図面を引いているのですから、これをうまく使わない手はありません。

もう一つ難儀したのは、文字を配置した後にプロパティを変更するところで、 基点座標を改めて設定し直さなければならなかった部门 です，"End Sub 難儀したのは、座標値のデータ型です，ESCキーを押すまで連続実行されます。

上図を単純化したものが以下の図-2です。

いつものようにdvbに生存してから実行します，破解下载， 高さ）Set objTxt = ThisDrawing.ModelSpace.AddText(strLength， テスト段階では文字の高さを牢固していましたが、高さを最初に入力できるようにしました（GetRealメソッド） この入力の部门については「SeaGate Annex : VBAではじめるAutoCADカスタマイズ 第7回」を参考にさせて頂きました， コーディングの提要です，◎の中心を結んだ線分の延長がマンホール間距離になります。