先日異なる値で連続オフセットする（AutoCAD 2011）で書きましたが、異なる値で連続オフセットするプログラムを作ってみました。
GetOffsetCurves メソッドでオフセットできるみたいだったので、結構簡単に作れるのかなと思って始めたんですた、なかなか難しかったです。
最初につまずいたのは、AutoCAD の OFFSET コマンドみたいにオフセットする側をクリックして指定できたら便利だと思ったんですが、どうやってやればいいのやら？？？
そのためのメソッドとかなにかあるのかなと思ったんですが、見つけられませんでした。
いろいろググッても見たんですが、それでも何も見つけられなくて…
ほとんど諦めかけてたんですが、ひょっとして 「元のオブジェクト と クリックした点の最短距離」 と 「オフセットしたオブジェクト と リックした点の最短距離」 を比較すればいのかなって思ってやってみたらできました。
もっといい方法があるのかどうかは分かりませんが、とりあえずできたのでよしとしましょう。
GetClosestPointTo メソッドで、クリックした点から一番近いオブジェクト上の点を求めて、DistanceTo メソッドで距離を求めました。
で、連続オフセットする最初の一回目だけ、 「元のオブジェクト と クリックした点の最短距離」 と 「オフセットしたオブジェクト と リックした点の最短距離」 を比較して、前者より後者の方が大きかったときはオフセットする方向を反対にしました。
それと、UCS を変更するとうまくいかないことがあるみたいだったので、UCS を WCS に変換するっていう手順も追加しました。
コードはこんな感じです。
' ---------------------------------------------
Imports System
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.EditorInput
Imports AVDO_Offset.DemandLoading.RegistryUpdate
' This line is not mandatory, but improves loading performances
<Assembly: CommandClass(GetType(AVDO_Offset.MyCommands))>
Namespace AVDO_Offset
Public Class MyCommands
<CommandMethod("AVDO_Offset", "AVDO_Offset", CommandFlags.Modal + CommandFlags.UsePickSet)> _
Public Sub AVDO_Offset()
Dim doc As Document = Application.DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database
Dim ed As Editor = doc.Editor
' オフセットのために選択したオブジェクトのオブジェクトID
Dim selEntID As ObjectId
' PickFirst 選択セットを取得
Dim psr As PromptSelectionResult = ed.SelectImplied()
If psr.Status = PromptStatus.OK Then
If psr.Value.Count > 1 Then
' 複数のオブジェクトが PickFirst 選択セットに含まれているときは、ひとつのオブジェクトを選択しなおす
selEntID = ed.GetEntity("オブジェクトを選択").ObjectId
Else
' ひとつだけのオブジェクトが PickFirst 選択セットに含まれているときは、そのオブジェクトIDを使用
selEntID = psr.Value.GetObjectIds(0)
End If
Else
' PickFirst 選択セットを取得できなかったときオブジェクトをオブジェクトを選択する
selEntID = ed.GetEntity(vbCrLf & "オブジェクトを選択").ObjectId
End If
' 何も選択されていなかったら、コマンドを終了する
If selEntID.IsValid = False Then
Return
End If
Using trans As Transaction = db.TransactionManager.StartTransaction
Dim ent As Entity = trans.GetObject(selEntID, OpenMode.ForRead)
' 選択されたオブジェクトが、オフセットの対象でない場合はコマンドを終了する
If (TypeOf ent Is Line) _
Or (TypeOf ent Is Arc) _
Or (TypeOf ent Is Circle) _
Or (TypeOf ent Is Ellipse) _
Or (TypeOf ent Is Polyline) _
Or (TypeOf ent Is Polyline2d) _
Or (TypeOf ent Is Spline) _
Or (TypeOf ent Is Xline) Then
Else
ed.WriteMessage(vbCrLf & "このオブジェクトはオフセットできません。")
Return
End If
End Using
' オフセットする方向を指定
Dim ppo As PromptPointOptions = New PromptPointOptions(vbCrLf & "オフセットする側の点を指定")
Dim ppr As PromptPointResult
ppr = ed.GetPoint(ppo)
If ppr.Status <> PromptStatus.OK Then
Return
End If
' オフセットする距離
Dim dist As Double = 0
' オフセットする距離の追加分
Dim distAdd As Double = 0
' オフセットしている回数
Dim cnt As Integer = 0
' オフセットする側
Dim ofstDirection As Boolean = True
While True
Using trans As Transaction = db.TransactionManager.StartTransaction
Try
Dim bt As BlockTable = trans.GetObject(db.BlockTableId, OpenMode.ForRead)
Dim btRec As BlockTableRecord
Dim cSpace As BlockTableRecord = trans.GetObject(db.CurrentSpaceId, OpenMode.ForRead)
If cSpace.Name = "*Model_Space" Then
btRec = trans.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite)
Else
btRec = trans.GetObject(bt(BlockTableRecord.PaperSpace), OpenMode.ForWrite)
End If
' 選択したオブジェクトに対して実行
Dim ent As Entity = trans.GetObject(selEntID, OpenMode.ForRead)
'オフセットされたオブジェクトコレクション
Dim dbObjColl As DBObjectCollection = Nothing
' オフセットする距離を入力させる
Dim pdo As PromptDistanceOptions
If cnt = 0 Then
pdo = New PromptDistanceOptions(vbCrLf & "距離を指定してください")
Else
pdo = New PromptDistanceOptions(vbCrLf & "距離を指定してください<" & distAdd & ">")
End If
pdo.AllowNone = True
pdo.AllowNegative = False
pdo.Keywords.Add("eXit", "eXit", "終了(X)")
Dim pdr As PromptDoubleResult
pdr = ed.GetDistance(pdo)
If pdr.Status <> PromptStatus.None Then
distAdd = pdr.Value
End If
' [終了(X)] オプションが選択されたときは、コマンドを終了
If pdr.StringResult = "eXit" Then
Return
End If
If cnt = 0 Then
If pdr.Status <> PromptStatus.OK Then
Return
End If
Else
If (pdr.Status <> PromptStatus.OK) And (pdr.Status <> PromptStatus.None) Then
Return
End If
End If
dist = dist + distAdd
' それぞれのオブジェクトに対するオブジェクトコレクションを作成
Dim ofstent As Curve = ent
' GetOffsetCurves で使うオフセット値
Dim ofstDist As Double
If ofstDirection = True Then
ofstDist = dist
Else
ofstDist = 0 - dist
End If
' オフセットしたオブジェクトを作成
Try
dbObjColl = ofstent.GetOffsetCurves(ofstDist)
Catch ex As Autodesk.AutoCAD.Runtime.Exception
ed.WriteMessage(vbCrLf & "このオブジェクトはオフセットできません。")
Return
End Try
' UCS を WCS に変換
Dim vpTblRec As ViewportTableRecord = trans.GetObject(doc.Editor.ActiveViewportId, OpenMode.ForWrite)
Dim newMatrix As Matrix3d = New Matrix3d()
newMatrix = Matrix3d.AlignCoordinateSystem(Point3d.Origin, _
Vector3d.XAxis, _
Vector3d.YAxis, _
Vector3d.ZAxis, _
vpTblRec.Ucs.Origin, _
vpTblRec.Ucs.Xaxis, _
vpTblRec.Ucs.Yaxis, _
vpTblRec.Ucs.Zaxis)
Dim pprWCS As Point3d = ppr.Value.TransformBy(newMatrix)
' オフセットする側が正しいか確認し、間違っていれば反対にする
Dim distOrg As Double = ofstent.GetClosestPointTo(pprWCS, True).DistanceTo(pprWCS) ' 元のオブジェクトと指定した点の距離
Dim distOfst As Double = distPtoObjColl(pprWCS, dbObjColl) ' オフセットしたオブジェクトと指定した点の距離
' 最初のオフセットのときに、オフセットする側が正しいか確認
If (cnt = 0) And (distOrg < distOfst) Then
dbObjColl.Dispose()
Try
dbObjColl = ofstent.GetOffsetCurves(-dist)
Catch ex As Autodesk.AutoCAD.Runtime.Exception
ed.WriteMessage(vbCrLf & "このオブジェクトはオフセットできません。")
Return
End Try
ofstDirection = False
End If
cnt += 1
' オフセットされたオブジェクトを追加
If dbObjColl <> Nothing Then
For Each acEnt As Entity In dbObjColl
btRec.AppendEntity(acEnt)
trans.AddNewlyCreatedDBObject(acEnt, True)
Next
End If
trans.Commit()
Catch ex As Autodesk.AutoCAD.Runtime.Exception
MsgBox(ex.Message)
End Try
End Using
End While
End Sub
' ある点と、オブジェクトコレクションにあるオブジェクトの最短距離を求める関数
Public Function distPtoObjColl(ByVal pt As Point3d, ByVal dbObjColl As DBObjectCollection) As Double
Dim dist As Double = 10 ^ 100
For Each acEnt As Curve In dbObjColl
Dim pt2 As Point3d = acEnt.GetClosestPointTo(pt, True)
Dim distTemp As Double = pt.DistanceTo(pt2)
If distTemp < dist Then
dist = distTemp
End If
Next
Return dist
End Function
End Class
End Namespace
' ---------------------------------------------
0 件のコメント:
コメントを投稿