AutoLispでテトリス！C＃のコードを書き替えた。

;; TetrisSquareクラスの定義
(defun TetrisSquare (x y color)
  (list x y color))

(defun TetrisSquareGetX (square)
  (nth 0 square))

(defun TetrisSquareGetY (square)
  (nth 1 square))

(defun TetrisSquareGetColor (square)
  (nth 2 square))

;; TetrisFieldクラスの定義
(defun TetrisField (/ width height squares)
  (setq width 10
        height 20
        squares (make-array (list height width))))

(defun TetrisFieldGetWidth ()
  width)

(defun TetrisFieldGetHeight ()
  height)

(defun TetrisFieldGetSquare (x y)
  (aref squares y x))

(defun TetrisFieldJudgeGameOver (block)
  (setq noEmptyCord (list)
        blockCord (list))

  (repeat height
    (repeat width
      (if (/= "gray" (TetrisSquareGetColor (TetrisFieldGetSquare x y)))
          (setq noEmptyCord (cons (cons x y) noEmptyCord)))
      (setq x (+ x 1))
      )
    (setq x 0
          y (+ y 1))
    )

  (foreach square (TetrisBlockGetSquares block)
    (setq cord (TetrisSquareGetCord square))
    (setq blockCord (cons (cons (car cord) (cadr cord)) blockCord))
    )

  (setq blockCord (vl-remove-if-not '(lambda (x) (member x noEmptyCord)) blockCord))

  (> (length blockCord) 0)
  )

(defun TetrisFieldJudgeCanMove (block direction)
  (setq noEmptyCord (list))

  (repeat height
    (repeat width
      (if (/= "gray" (TetrisSquareGetColor (TetrisFieldGetSquare x y)))
          (setq noEmptyCord (cons (cons x y) noEmptyCord)))
      (setq x (+ x 1))
      )
    (setq x 0
          y (+ y 1))
    )

  (setq moveBlockCord (list))

  (foreach square (TetrisBlockGetSquares block)
    (setq cord (TetrisSquareGetMovedCord square direction))
    (setq moveBlockCord (cons (cons (car cord) (cadr cord)) moveBlockCord))

    (if (or (< (car cord) 0)
            (>= (car cord) width)
            (< (cadr cord) 0)
            (>= (cadr cord) height))
        (return nil)
        )
    )

  (setq moveBlockCord (vl-remove-if-not '(lambda (x) (member x noEmptyCord)) moveBlockCord))

  (= (length moveBlockCord) 0)
  )

(defun TetrisFieldFixBlock (block)
  (foreach square (TetrisBlockGetSquares block)
    (setq x (car (TetrisSquareGetCord square))
          y (cadr (TetrisSquareGetCord square))
          color (TetrisSquareGetColor square))
    (setq (nth y (nth x squares)) (TetrisSquare x y color))
    )
  )

(defun TetrisFieldDeleteLine ()
  (setq y (- height 1))

  (while (>= y 0)
    (setq isFull T)

    (setq x 0)
    (while (< x width)
      (if (= "gray" (TetrisSquareGetColor (TetrisFieldGetSquare x y)))
          (setq isFull nil))
      (setq x (+ x 1))
      )

    (if isFull
        (progn
          (setq yy y)
          (while (> yy 0)
            (setq x 0)
            (while (< x width)
              (setq (nth yy (nth x squares)) (TetrisSquareGetX (nth (- yy 1) (nth x squares)))
                                              (TetrisSquareGetY (nth (- yy 1) (nth x squares)))
                                              (TetrisSquareGetColor (nth (- yy 1) (nth x squares)))))
              (setq x (+ x 1))
              )
            (setq yy (- yy 1))
            )

          (setq x 0)
          (while (< x width)
            (setq (nth 0 (nth x squares)) (TetrisSquare x 0 "gray"))
            (setq x (+ x 1))
            )

          (setq y (+ y 1))
          )
        )

    (setq y (- y 1))
    )
  )

;; TetrisBlockクラスの定義
(defun TetrisBlock (/ squares)
  (setq squares (list))

  (setq blockType (random 4))

  (cond
    ((= blockType 0)
     (setq color "red"
           cords (list (list (/ 10 2) 0)
                       (list (/ 10 2) 1)
                       (list (/ 10 2) 2)
                       (list (/ 10 2) 3))))
    ((= blockType 1)
     (setq color "blue"
           cords (list (list (/ 10 2) 0)
                       (list (/ 10 2) 1)
                       (list (- (/ 10 2) 1) 0)
                       (list (- (/ 10 2) 1) 1))))
    ((= blockType 2)
     (setq color "green"
           cords (list (list (- (/ 10 2) 1) 0)
                       (list (/ 10 2) 0)
                       (list (/ 10 2) 1)
                       (list (/ 10 2) 2))))
    ((= blockType 3)
     (setq color "orange"
           cords (list (list (/ 10 2) 0)
                       (list (- (/ 10 2) 1) 0)
                       (list (- (/ 10 2) 1) 1)
                       (list (- (/ 10 2) 1) 2))))
    (T
     (setq color "gray"
           cords nil))
    )

  (foreach cord cords
    (setq squares (cons (TetrisSquare (car cord) (cadr cord) color) squares))
    )

  squares
  )

(defun TetrisBlockGetSquares (block)
  squares)

(defun TetrisBlockMove (block direction)
  (setq newSquares (list))

  (foreach square squares
    (setq movedCord (TetrisSquareGetMovedCord square direction)
          x (car movedCord)
          y (cadr movedCord))
    (setq newSquares (cons (TetrisSquare x y (TetrisSquareGetColor square)) newSquares))
    )

  (setq squares newSquares)
  )

;; TetrisGameクラスの定義
(defun TetrisGame (/ field block canvas)
  (setq field (TetrisField)
        block nil
        canvas nil))

(defun TetrisGameStart ()
  (setq field (TetrisField)
        block nil
        canvas (TetrisCanvas field))
  )

(defun TetrisGameNewBlock ()
  (setq block (TetrisBlock))

  (if (TetrisFieldJudgeGameOver block)
      (progn
        (princ "GAMEOVER")
        (terpri))
      )

  )

(defun TetrisGameMoveBlock (direction)
  (if (TetrisFieldJudgeCanMove block direction)
      (progn
        (TetrisBlockMove block direction)
        (TetrisCanvasUpdate canvas field block))
    (if (= direction 2)
        (progn
          (TetrisFieldFixBlock block)
          (TetrisFieldDeleteLine)
          (TetrisGameNewBlock)
          (TetrisCanvasUpdate canvas field block))
      )
    )
  )

;; TetrisCanvasクラスの定義
(defun TetrisCanvas (field)
  (setq beforeField field
        field field))

(defun TetrisCanvasUpdate (field block)
  (setq beforeField field)

  ;; キャンバスを更新する処理
  )

;; TetrisCommandsクラスの定義
(defun c:TETRIS ()
  (setq field (TetrisField)
        block nil
        canvas (TetrisCanvas field)
        game (TetrisGame))

  (TetrisGameStart)

  (while T
    ;; ユーザー入力を取得し、適切な方向で game.MoveBlock(direction) を呼び出す
    )
  )

さてどうなるか？

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

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

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

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

漢字、カタカナ、平仮名のコマンドがAutocadで使える！

<"直", "ライン", "l">と書き換えて試したら、継承がどうのこうのとかVBコードのデバッグ&コンパイルの段階でエラーとなり、しかもAutocad側ではコマンド入力ボックスにcookieみたいなモンがあるみたいで、前に入力した<"直線">に反応してしまったので、

<"せん">

<"ちょく">

<"ライン">

と単純に並べてみたら成功した。

こうすれば一つの機能に好きなコマンド名をいくらでも割当てられることが分かった。

Autocadで<直線>という漢字のコマンドで直線を描くことに成功！

見事に成功！

①Visual Basic.NETのソースコードで<直線>に書き換えて、

❷直線というコマンドを入力し、

③二本目の直線が描画されている。

しかも「始点の座標を入力してください」とCHATBOTの機能も使えている。

世界一速いオートキャドの操作方法

世界一速いオートキャドの操作方法

短縮コマンドを使いこなしているらしい。

俺がVisual Basic.NETでやってきたことに近いが、例えばチャットボットならCHATBOTとコマンドを入れていたのをCまたはcと入れれば済むようにすれば良いことだ。

具体的には<CHATBOT>を<c>に変えるだけの話。

参考までにこの方の短縮コマンド割当リストなるものを載せておく。

ツール⇒カスタマイズ⇒プログラムパラメータの書き出し」を選択するとメモ帳が立ち上がり、この中に短縮コマンドの割り当てが記述されているので、このデータを編集すれば良いらしい。

次回は<>の中を平仮名とか漢字にしたり、cを円、lを直線コマンドに割当てて<c, l, C, L>と書いてみて一つのプログラム内に二つのコマンドを入れて選べるようにできるか試してみたい。

※追伸

押出しくり抜きコマンド（VBとかC#じゃなくて元々Autocadで用意されているコマンド）があるようだ。

EXTRUDEと入力すれば使えるらしい。

※追追伸

EXTRUDEコマンドで直方体を作ってみた。

適当に長方形を描いてEXTRUDEコマンドを入力し、高さを100と入力したら成功。

VisualBasic.NetでAutoCAD直線描画CHATBOT作成に成功！

Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.Runtime

Public Class DrawLineCommands

<CommandMethod("DrawLine")>
Public Sub DrawLine()
Dim doc As Document = Application.DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database
Dim ed As Editor = doc.Editor

' 1. 始点の座標を入力するダイアログボックスを表示する
Dim startPoint As PromptPointResult = ed.GetPoint("始点の座標を入力してください:")
If startPoint.Status <> PromptStatus.OK Then
Return
End If

' 2. 終点の座標を入力するダイアログボックスを表示する
Dim endPoint As PromptPointResult = ed.GetPoint("終点の座標を入力してください:")
If endPoint.Status <> PromptStatus.OK Then
Return
End If

' 3. 入力された座標を反映する
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 line As New Line(startPoint.Value, endPoint.Value)
btr.AppendEntity(line)
tr.AddNewlyCreatedDBObject(line, True)

tr.Commit()
End Using

ed.WriteMessage("Line drawn successfully.")
End Sub

End Class

ChatGPTには座標入力コンポーネントの表示をしてくれと頼んだが、コマンド入力ボックスの上に始点（または終点）の座標を入力してくださいと表示されるにとどまった。

ちなみに写真では、一本目の直線の終点に二本目の直線の始点に選んでコマンド”DrawLine”を入力すると、

再度チャットボットの会話が始まり、終点の入力を促される。

まだ少々問題点が残ったが、やりたいことに向けて着々と進んでいる！

【追伸】

この直線描画CHATBOTはいちいち座標を入力する必要がない。マウスを動かして任意の位置にポインターをあわせてワンクリックし、始点や終点として選べるようになっている。

すでに出来上がったエレメントの端点にポインターを合わせれば、そこを始点に直線をひける。

AUTOCADでチャットボット！改造してみたｗｗｗ

改造したのはこの部分だけｗｗｗ

Private Function GetResponse(input As String) As String
' ユーザーの入力に応じて適切な応答を生成
Select Case input.ToLower()
Case "バカ！", "アホ"
Return "何だテメェゴルァ！凸（◎曲◎♯）"
Case "かかってこいよ"
Return "ヘタレ！"
Case "口先番長", "詐欺師", "バカチョン"
Return "一昨日きやがれ！"
Case Else
Return "日本語しゃべれねーのか？このバカチョンチャンコロめが！"
End Select

文字化けするかな？と思ったが、あっさり成功。

バカ！またはアホと入力すると、

何だテメェゴルァ！凸（◎曲◎♯）

と顔文字付きでレスが来るのが今回狙った改造箇所。

CaseやReturnの””内は自由に変えられるし、AまたはBまたはCと入力が変わる場合、

Case "A", "B", "C"のように「,」で区切ればよい。

AutoCADで簡易チャットボットをやってみたｗｗｗ

ソースコードはVB.NET。

Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Runtime

Public Class ChatBotCommands

<CommandMethod("CHATBOT")>
Public Sub StartChatBot()
Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor

While True
Dim userInput As String = GetUserInput("You: ")
Dim response As String = GetResponse(userInput)
ed.WriteMessage($"Bot: {response}" & vbCrLf)
End While
End Sub

Private Function GetUserInput(prompt As String) As String
Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
Dim options As PromptStringOptions = New PromptStringOptions(prompt)
options.AllowSpaces = True
Dim result As PromptResult = ed.GetString(options)
If result.Status = PromptStatus.OK Then
Return result.StringResult
Else
Return String.Empty
End If
End Function

Private Function GetResponse(input As String) As String
' ユーザーの入力に応じて適切な応答を生成
Select Case input.ToLower()
Case "hello", "hi"
Return "Hello! How can I help you?"
Case "how are you?"
Return "I'm just a program, so I don't have feelings, but thanks for asking!"
Case "bye", "exit", "quit"
Return "Goodbye! Have a great day!"
Case Else
Return "I'm sorry, I didn't understand that."
End Select
End Function

End Class

Case１「 "hello", "hi"」と入力すると

Return "Hello! How can I help you?"

Case２ 「"how are you?"」と入力すると

Return "I'm just a program, so I don't have feelings, but thanks for asking!"

Case３ "bye", "exit", "quit"

Return "Goodbye! Have a great day!"

Case Else　例えばFuck You！と入力すると・・・

Return "I'm sorry, I didn't understand that."

それ以外も同様となる。なかなか面白かった。

ちなみに、三角錐とか円錐とか、立方体を円柱でくり抜くとかちょっと高度なコードをChatGPTにコード生成させたらエラーばっかで全然だめだったので、チャットボットにしてみた。テトリスはAUTOLISPでは動いたが、VB.NETではだめだった。インベーダーゲームも試したがだめだった。

AutoCADでVB.NETを使い球を自動で描かせることに成功！

またまたChatGPTがやってくれた！すげーよ！マジ神！

指定した場所に半径300の球を一瞬で描いた。

最初は失敗したかな？と思ったが３D表示に変えると、金属光沢のある球ができていた。

Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.Runtime

Public Class Class1

    <CommandMethod("SPHERE")>
    Public Sub DrawSphere()
        ' ダイアログを表示して中心点を取得
        Dim dialogResult As PromptPointResult = GetPoint("Specify center point: ")
        If dialogResult.Status <> PromptStatus.OK Then
            Exit Sub
        End If
        Dim centerPoint As Point3d = dialogResult.Value

        ' 半径300の球を描画
        DrawSphere(centerPoint, 300)
    End Sub

    Private Function GetPoint(message As String) As PromptPointResult
        Dim editor As Editor = Application.DocumentManager.MdiActiveDocument.Editor
        Dim promptOptions As PromptPointOptions = New PromptPointOptions(message)
        Dim pointResult As PromptPointResult = editor.GetPoint(promptOptions)
        Return pointResult
    End Function

    Private Sub DrawSphere(centerPoint As Point3d, radius As Double)
        Dim doc As Document = Application.DocumentManager.MdiActiveDocument
        Dim db As Database = doc.Database

        Using trans As Transaction = db.TransactionManager.StartTransaction()
            Try
                ' ブロックテーブルとブロックテーブルレコードを開く
                Dim bt As BlockTable = trans.GetObject(db.BlockTableId, OpenMode.ForRead)
                Dim btr As BlockTableRecord = CType(trans.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite), BlockTableRecord)

                ' 半径300の球を作成
                Dim sphere As Solid3d = New Solid3d()
                sphere.CreateSphere(radius)
                sphere.TransformBy(Matrix3d.Displacement(centerPoint.GetAsVector()))
                btr.AppendEntity(sphere)
                trans.AddNewlyCreatedDBObject(sphere, True)

                trans.Commit()
            Catch ex As Exception
                Application.ShowAlertDialog("Error: " & ex.Message)
                trans.Abort()
            End Try
        End Using
    End Sub

End Class

AutoCADでVB.NETを使い自動で五角形を描かせることに成功！

一辺が100の五角形を描くVB.netプログラム。任意の中心を指定するだけ。

VBのソースコードの部分だけ以下のようにChatGPTに質問して書いてもらった。

Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.Runtime

Public Class Class1

    <CommandMethod("PENTAGON")>
    Public Sub DrawPentagon()
        ' ダイアログを表示して中心点を取得
        Dim dialogResult As PromptPointResult = GetPoint("Specify center point: ")
        If dialogResult.Status <> PromptStatus.OK Then
            Exit Sub
        End If
        Dim centerPoint As Point3d = dialogResult.Value

        ' 一辺が100の五角形を描画
        DrawRegularPentagon(centerPoint, 100)
    End Sub

    Private Function GetPoint(message As String) As PromptPointResult
        Dim editor As Editor = Application.DocumentManager.MdiActiveDocument.Editor
        Dim promptOptions As PromptPointOptions = New PromptPointOptions(message)
        Dim pointResult As PromptPointResult = editor.GetPoint(promptOptions)
        Return pointResult
    End Function

    Private Sub DrawRegularPentagon(centerPoint As Point3d, sideLength As Double)
        Dim doc As Document = Application.DocumentManager.MdiActiveDocument
        Dim db As Database = doc.Database

        Using trans As Transaction = db.TransactionManager.StartTransaction()
            Try
                ' ブロックテーブルとブロックテーブルレコードを開く
                Dim bt As BlockTable = trans.GetObject(db.BlockTableId, OpenMode.ForRead)
                Dim btr As BlockTableRecord = CType(trans.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite), BlockTableRecord)

                ' 一辺が100の五角形を作成
                Dim pentagonPoints As Point2dCollection = GetRegularPentagonPoints(centerPoint, sideLength)
                Dim poly As Polyline = New Polyline()
                For Each point As Point2d In pentagonPoints
                    poly.AddVertexAt(poly.NumberOfVertices, point, 0, 0, 0)
                Next

                poly.Closed = True
                btr.AppendEntity(poly)
                trans.AddNewlyCreatedDBObject(poly, True)

                trans.Commit()
            Catch ex As Exception
                Application.ShowAlertDialog("Error: " & ex.Message)
                trans.Abort()
            End Try
        End Using
    End Sub

    Private Function GetRegularPentagonPoints(centerPoint As Point3d, sideLength As Double) As Point2dCollection
        Dim points As Point2dCollection = New Point2dCollection()

        For i As Integer = 0 To 4
            Dim angle As Double = i * (2 * Math.PI) / 5
            Dim x As Double = centerPoint.X + sideLength * Math.Cos(angle)
            Dim y As Double = centerPoint.Y + sideLength * Math.Sin(angle)
            points.Add(New Point2d(x, y))
        Next

        Return points
    End Function

End Class

AutoCADでコマンド「PENTAGON」と入力し、中心を指定すると・・・

このように一瞬で一辺100の五角形が出現した。マウスでカチャカチャやったら何秒かかるだろうか？

小さなプログラムのブロックをたくさん作って組み合わせていけば、作図スピードが何十倍にも上がるのは言うまでもない。

最速攻略AutoCAD VB.NETマクロサンプル大全集いいよ、最高だよ。

最速攻略AutoCAD VB.NETマクロサンプル大全集AutoCAD2009/2010/2011/2012/2013対応 https://amzn.asia/d/gT7IIvT

C#やC++とも関連してるし、ソースコードをChatGPTで書き換えてトランスパイルして使い回すことも可能だし、Visual F#という新しい言語でも開発できるだろうし。

AutoCAD2023でVB.NETを使いHelloWorldの表示に成功！

技術評論社の2012年出版の古い本だが、「AutoCAD VB.NETマクロサンプル大全集」を見ながら頑張ってみた。

まずはVisualStudioで以下のＶＢ.ＮＥＴコードを書く。

Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.EditorInout
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.EditorInput

Public Class Class1

    <CommandMethod("HLWL")>
    Public Sub MyHelloWorld()

        Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
        ed.WriteMessage(vbCrLf + "Hello World!")
    End Sub

End Class

その後の表現が我々初心者プログラミング厨房にとって難解極まりない。

参照するだのパスを通すだの、詳しく説明せずに煙に巻くのはやめんかい！！！（この本のことではなく、他の本またはサイト）

マジぶっ●すぞ！！！（この本にはそこそこ分かりやすく書かれてあったからこそ成功したのだ。）

参照とは、一番上の帯でプロジェクトというところを選び、このプログラムのプロジェクト名のプロパティの部分を押すと、本で指定されたdllファイルを選んでチェックを入れ、Trueに設定変更するように指示が出ているので、その通りに従えばよい。(accoremgd.dll,acdbmgd.dll,acmgd.dllの3つ)

そして、どのサイトを見ても書かれていなかったのが「パスを通す」という表現の作業であった。

具体的に何をするのかというと、いったんこのプログラムを書き終えて参照設定まで終えたらビルドボタンを押すと、幾種類かのファイルが生成されるので、その中のプロジェクト名.vbprojというファイルをメモ帳で開いて中身を編集していくことになるのだ。その過程でacad.exeというファイルのディレクトリをフルパスで「C:￥Program Files￥Autodesk￥AutoCAD 2023￥acad.exe（この部分は個々のPCの設定によって変わるので、acad.exeがどこにあるか探してディレクトリパスをコピっておくべき）」（なぜか半角￥はブログに書けない）追記する場面があるから、それをパスを通すと呼んでいるらしい。自称凄腕プログラマー＆エンジニアはそういうわけわからん事ばかりほざいてドヤ顔で悦に浸り、後進の教育をおろそかにするから日本は世界で最低レベルとバカにされるんだよ。教えるのがめんどくさいとか教えてる時間がないとか嘘の言い訳をし、教える能力がないのがバレるのを恐れているだけだ。

愚痴はここまでにして・・・本には <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">

のすぐ下に <StartAction>Program</StartAction>
    <StartProgram>C:￥Program Files￥Autodesk￥AutoCAD 2023￥acad.exe</StartProgram>

と追記して上書き保存し、ビルドしたプログラムをデバッグするとAutoCADが立ち上がり、

作図画面上でコマンドと表示されている状態で、NETLOADと入力すると.NETアセンブリを選択するというウィンドウが立ち上がるので、Hello_World.dllを選んで開き、HLWLとコマンドを打つと無事HelloWorld！と表示されて成功に終わった。

本文は以上。以下は画面のキャプチャー画像。

１．VB.NETのソースコード打ち込みの様子。

２．いわゆるパスを通している所ｗｗｗメモ帳で追記しているだけだがｗｗｗ

３．小さすぎて見えないが中央下部にHelloWorldが表示されている所。

山場、難所は超えたから次はもっと難しいこと、さらにC＃やF＃でソースコードを書き替えて実践してみたい。

古い本なのに、AutoCAD2023とVisual Studio2022で本に書かれてある内容そのままでバッチリ動いて成功できたのは非常に大きな一歩だ！！！

おい、ボンクラ自称プログラマー、エンジニア共よ、首を洗って待って居ろ。いずれフリーランスとなってつぶしにいってやるからな、覚悟せい！！！

 

 

 

Autocad_webの無料アカウント

Autocad webは無料で使えるアカウントが作れるらしい。

AutoLispでテトリスをやってみたらwww

 

■□

□■

しか出てこんやんけwww

このポンコツソースコードめが！

Autocadでテトリス！AutoLisp言語でテトリス！

Tetris for AutoCAD - help with grread

(defun c:tetris ( / ) ;;----------------------=={ Remove Nth }==--------------------;; ;; ;; ;; Removes the item at the nth index in a supplied list ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; n - index of item to remove (zero based) ;; ;; l - list from which item is to be removed ;; ;;------------------------------------------------------------;; ;; Returns: List with item at index n removed ;; ;;------------------------------------------------------------;; (defun LM:RemoveNth ( n l / i ) (setq i -1) (vl-remove-if '(lambda ( x ) (= (setq i (1+ i)) n)) l) );defun (defun CreateCanvas () (setq canvasEnt (LWPoly (list origin (mapcar '+ origin (list 0 (* rows pixelSize) 0)) (mapcar '+ origin (list (* cols pixelSize) (* rows pixelSize) 0)) (mapcar '+ origin (list (* cols pixelSize) 0 0)))) ) (ClearCanvas rows cols) );defun (defun ClearCanvas (rows cols) (setq canvas nil) (repeat rows (setq canvas (cons (repeat cols (EmptyRow)) canvas))) );defun (defun EmptyRow ( / row) (repeat cols (setq row (cons 0 row))) );defun (defun RemoveRow (rowPos / row) (setq canvas (append (LM:RemoveNth rowPos canvas) (list (EmptyRow)))) );defun (defun LWPoly (lst) (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length lst)) (cons 70 1)) (mapcar (function (lambda (p) (cons 10 p))) lst))) );defun (defun NewPixel (pt) (setq activeShapePos (cons (mapcar '/ pt (list 10 10)) activeShapePos)) (LWPoly (list pt (mapcar '+ pt (list 0 pixelSize 0)) (mapcar '+ pt (list pixelSize pixelSize 0)) (mapcar '+ pt (list pixelSize 0 0)))) );defun (defun Shape1 () (setq activeShapePos nil) (mapcar '(lambda (pixel) (ssadd pixel activeShape) ) (list (NewPixel spawnPoint) (NewPixel (mapcar '+ spawnPoint (list 0 pixelSize 0))) (NewPixel (mapcar '+ spawnPoint (list pixelSize pixelSize 0))) (NewPixel (mapcar '+ spawnPoint (list pixelSize 0 0))) ) ) );defun (defun SpawnShape (shape) (setq activeShape (ssadd)) (cond ((= shape 1) (Shape1)) );cond );defun ;;;(defun ShapeStop (shape) ;;; ;;;);defun ;;; ;;;(defun ShapeRotate (shape) ;;; ;;;);defun (defun MoveUp () (command "move" activeShape "" (list 0 0 0) (list 0 pixelSize 0)) );defun (defun MoveDown () (command "move" activeShape "" (list 0 0 0) (list 0 (* pixelSize -1) 0)) );defun (defun MoveLeft () (command "move" activeShape "" (list 0 0 0) (list (* pixelSize -1) 0 0)) );defun (defun MoveRight () (command "move" activeShape "" (list 0 0 0) (list pixelSize 0 0)) );defun (defun sleep (secs / time) (setq time (getvar "Millisecs")) (while (< (/ (- (getvar "Millisecs") time) 1000.0) secs) nil) );defun ;;; ;;; FUNCTION STARTS HERE ;;; (setq origin (list 0 0 0)) (setq pixelSize 10) (setq rows 20) (setq cols 10) (setq spawnPoint (mapcar '+ origin (list (* (- (/ cols 2) 1) pixelSize) (* rows pixelSize) 0))) ;;;(setq canvasX (* pixelSize cols)) ;;;(setq canvasY (* pixelSize rows)) ;;;(setq color 7) ;;;(setq activeShapeColor 3) (setq gameOver nil) (setq timer nil) (setq tick 0.5) (command "_-view" "_t") (command "_ucs" "_w") (CreateCanvas) (command "_zoom" "o" canvasEnt "") (SpawnShape 1) (while (not gameOver) (if (not timer) (setq timer (getvar "Millisecs"))) (if (< (/ (- (getvar "Millisecs") timer) 1000.0) tick) (progn (setq gRead (grread T 15 1) grCode (car gRead) grVal (cadr gRead)) (cond ;Quit game ((vl-position grVal '(113 81)) (setq gameOver T) (alert "Game Over!"));q Q ((vl-position grVal '(115 83)) (MoveDown));s S ((vl-position grVal '(97 65)) (MoveLeft));a A ((vl-position grVal '(100 68)) (MoveRight));d D ((vl-position grVal '(119 87)) (MoveUp));w W for testing );cond ) (progn (MoveDown) (setq timer (getvar "Millisecs")) ) ) );main loop (princ) );defun