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