CyberChaos(さいばかおす)

プログラミング言語、トランスパイラ、RPA、ChatGPT、データマイニング、リバースエンジニアリングのための忘備録

CADチャットボットプロトタイプ完成!

2024-04-29 12:33:28 | Autocad

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座標の入力を求めてくる。

とりあえず目標達成となった。

あとはいろいろな機能を追加していくだけとなった。



最新の画像もっと見る

コメントを投稿

ブログ作成者から承認されるまでコメントは反映されません。