SOLIDWORKS APIを試してみた② プログラムをChatGPTで変更してみた

はじめに

前回、「SOLIDWORKS APIでプログラムを取り込む」という内容で、図面ファイルをPDFとDXFに変換して同じフォルダに置くプログラムを実行させてみました。

(前回の記事)　SOLIDWORKS APIを試してみた

しかし、変換した図面データは設計データと同じフォルダではなく、できれば他の場所に作成してほしい…。筆者の場合、データ提出する場合はデスクトップにフォルダを作り、各ファイル名の末尾に提出日の日付を付けて保存し、データをまとめてフォルダごと圧縮をかけるということを行います。そこで、この変更を自力でやってみようと考えました。

ChatGTPでプログラムを分析

プログラムに関してはさっぱりわからないので、まず、もらったプログラムの中身をSW上の「ツール」⇒「マクロ」⇒「編集」で開き、コピペしてChatGTPに読ませてみました。

おお！なにも伝えてないのに、ナニでソレをしたいってのがよくわかったねえ。
その上、問題点の指摘と改善策の提案までしてくださいます。

改善策を盛り込んだプログラムを実行させてみると、その通りにできていました。
これはもしや、変更したい内容を書けば改善して頂けるのでは？？
試しに、「このプログラムでデスクトップに「提出データ」という新しいフォルダを作って、そこにPDFとDXFファイルに変換して保存するようにしたい。ファイル名末尾には_YYMMDDで今日の日付をつけたい。」とお願いしてみると、数秒でプログラムが生成されました。

これを同じくSWにコピペして取り込み、図面のファイルを開いてアイコンをクリックすると、デスクトップの新しいフォルダに日付のついたPDFとDXFファイルが出来ました。

実際のプログラムがこちら

Sub main()
   Dim swApp As Object
    Dim Part As Object
    Set swApp = Application.SldWorks
    Set Part = swApp.ActiveDoc

    ' アクティブなドキュメントがない場合、メッセージを表示して終了
    If Part Is Nothing Then
        MsgBox "アクティブな図面ドキュメントがありません。", vbExclamation, "エラー"
        Exit Sub
    End If

    ' 図面データ（SLDDRW）以外は処理しない
    If Part.GetType <> 3 Then
        MsgBox "図面（SLDDRW）ファイルではありません。", vbExclamation, "エラー"
        Exit Sub
    End If

    ' ファイルが保存されているか確認
    If Part.GetPathName = "" Then
        MsgBox "ファイルが保存されていません。保存してから実行してください。", vbExclamation, "エラー"
        Exit Sub
    End If

    ' デスクトップの「提出データ」フォルダのパス
    Dim sDesktopPath As String
    Dim sSaveFolder As String
    sDesktopPath = Environ("USERPROFILE") & "\Desktop"
    sSaveFolder = sDesktopPath & "\提出データ"

    ' フォルダが存在しない場合は作成
    If Dir(sSaveFolder, vbDirectory) = "" Then
        MkDir sSaveFolder
    End If

    ' 図面のファイル名（拡張子なし）
    Dim sBaseFileName As String
    Dim lFindPoint As Long
    lFindPoint = InStrRev(Part.GetPathName, "\")
    sBaseFileName = Mid(Part.GetPathName, lFindPoint + 1)
    lFindPoint = InStrRev(sBaseFileName, ".")
    If lFindPoint > 0 Then
        sBaseFileName = Left(sBaseFileName, lFindPoint - 1)
    End If

    ' 日付を追加
    Dim sDateStr As String
    sDateStr = "_" & Format(Date, "yyyymmdd")

    ' 保存ファイルのパス
    Dim sPdfPath As String, sDxfPath As String
    sPdfPath = sSaveFolder & "\" & sBaseFileName & sDateStr & ".pdf"
    sDxfPath = sSaveFolder & "\" & sBaseFileName & sDateStr & ".dxf"

    ' PDFとDXFを保存
    Dim longstatus As Long
    longstatus = Part.SaveAs3(sPdfPath, 0, 2)
    longstatus = Part.SaveAs3(sDxfPath, 0, 2)

    ' 完了メッセージ
    MsgBox "図面データを保存しました。", vbInformation, "完了"
End Sub

おわりに

解説してもらうつもりでプログラムをコピぺしたChatGTPでしたが、懇切丁寧に教えて頂けた上に修正と変更までしてもらい、その上日本語での変更要望に応えて頂けるとは、なんと仕事のできる方でしょう。
これはもしかしたらプログラムを一から組むのも丸投げできるのでは？？
次回やってみましょう。