Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Geometry
Public Class MyCommands
<CommandMethod("bot")>
Public Sub ProcessUserInput()
Dim doc As Document = Application.DocumentManager.MdiActiveDocument
Dim ed As Editor = doc.Editor
Dim userInput As String = GetStringFromUserInput("CAD", "何をしましょうか？")
If userInput.Contains("直線") Then
CreateLine()
ElseIf userInput.Contains("円") Then
CreateCircle()
Else
ed.WriteMessage("そのような操作はできません。")
End If
End Sub
Private Sub CreateLine()
Dim doc As Document = Application.DocumentManager.MdiActiveDocument
Dim ed As Editor = doc.Editor
Dim start_x As Double = GetDoubleFromUserInput("始点のX座標を入力してください。")
Dim start_y As Double = GetDoubleFromUserInput("始点のY座標を入力してください。")
Dim end_x As Double = GetDoubleFromUserInput("終点のX座標を入力してください。")
Dim end_y As Double = GetDoubleFromUserInput("終点のY座標を入力してください。")
DrawLine(start_x, start_y, end_x, end_y)
End Sub
Private Sub CreateCircle()
Dim doc As Document = Application.DocumentManager.MdiActiveDocument
Dim ed As Editor = doc.Editor
Dim center_x As Double = GetDoubleFromUserInput("中心のX座標を入力してください。")
Dim center_y As Double = GetDoubleFromUserInput("中心のY座標を入力してください。")
Dim radius As Double = GetDoubleFromUserInput("半径を入力してください。")
DrawCircle(center_x, center_y, radius)
End Sub
Private Function GetDoubleFromUserInput(prompt As String) As Double
Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
While True
Dim result As PromptDoubleResult = ed.GetDouble(prompt)
If result.Status = PromptStatus.OK Then
Return result.Value
Else
ed.WriteMessage("数値を入力してください。")
End If
End While
' この行は通常、到達されませんが、関数のすべてのコードパスで値が返されることを確認します
Return 0.0
End Function
Private Function GetStringFromUserInput(title As String, prompt As String) As String
Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
Return ed.GetString(prompt).StringResult
End Function
Private Sub DrawLine(startX As Double, startY As Double, endX As Double, endY As Double)
Dim doc As Document = Application.DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database
Using tr As Transaction = db.TransactionManager.StartTransaction()
Dim bt As BlockTable = tr.GetObject(db.BlockTableId, OpenMode.ForRead)
Dim btr As BlockTableRecord = tr.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite)
Dim startPoint As New Point3d(startX, startY, 0)
Dim endPoint As New Point3d(endX, endY, 0)
Dim line As New Line(startPoint, endPoint)
btr.AppendEntity(line)
tr.AddNewlyCreatedDBObject(line, True)
tr.Commit()
End Using
End Sub
Private Sub DrawCircle(centerX As Double, centerY As Double, radius As Double)
Dim doc As Document = Application.DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database
Using tr As Transaction = db.TransactionManager.StartTransaction()
Dim bt As BlockTable = tr.GetObject(db.BlockTableId, OpenMode.ForRead)
Dim btr As BlockTableRecord = tr.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite)
Dim centerPoint As New Point3d(centerX, centerY, 0)
Dim circle As New Circle(centerPoint, Vector3d.ZAxis, radius)
btr.AppendEntity(circle)
tr.AddNewlyCreatedDBObject(circle, True)
tr.Commit()
End Using
End Sub
End Class
botというコマンドを入力すると、何をしましょうか？と訊いてきて、
円と入力すると中心のX座標、Y座標、そして半径の入力を求めてくる。
直線と入力すると始点のX座標、Y座標、終点のX座標、Y座標の入力を求めてくる。
とりあえず目標達成となった。
あとはいろいろな機能を追加していくだけとなった。
