メモ‎ > ‎AutoCAD VBA‎ > ‎

VBAの自動実行(つづく)

2010/06/11 15:52 に mura が投稿   [ 2010/06/11 19:17 に更新しました ]
オンラインヘルプには、
「マクロに AcadStartup という名前を付けることにより、VBA のロード時にマクロが自動的に実行されるようにできます。 acad.dvb ファイル内にある AcadStartup という名前のマクロは、VBA のロード時に自動的に実行されます。 」
と、あるのに、AcadStartupが自動的に実行されるのは「acad.dvb」だけのようです。 まあ、ウイルス対策上その方が好ましいのかもしれないのですけど、面倒なときもあります。
そこで、dvbファイルを画面にドラッグした場合だけAcadStartupを自動実行するVBAを作成する事に。
これでVBAをドラッグすると、その中に定義したツールバーが自動的に作成されるというVBAの環境が整います。

最初にAcadStartupを自動実行するVBAを実行するため(鶏と卵の関係?) LISPを使うことにしました。
(基本的には)acad.lspは起動時 最初の1回だけ実行すれば十分です。
なお、acad.lspとACADStartup.dvbはacad.exeと同じフォルダに置きます。

'--- acad.lspの内容 ---
(defun S::STARTUP() 
     (command "_-vbarun" "./ACADStartup.dvb!ThisDrawing.ACADStartup") 
こちらは、イベントをトラップしています。
サンプルの流用程度の簡単なプログラム。
ロードしたVBAに、AcadStartupがあれば実行してくれます。
'--- ACADStartup.dvb の内容 ---
Option Explicit
Public WithEvents ACADApp As AcadApplication
Option Compare Text

Sub ACADStartup()
    ' この手続きを最初に実行してください。
    ' Public変数(ACADApp)を初期化し AcadApplication イベントを発生させます
    ' ThisDocument オブジェクトからアプリケーション オブジェクトを取得します
    
    Dim AcadWasNotRunning As Boolean
    ' エラーのトラップを留保します。
    On Error Resume Next
    Set ACADApp = GetObject(, "AutoCAD.Application.16")
    If Err.Number <> 0 Then AcadWasNotRunning = True
    Err.Clear    ' エラーが発生した場合は Err オブジェクトをクリアします。
End Sub

Private Sub ACADApp_BeginFileDrop _
                 (ByVal FileName As String, Cancel As Boolean)
    ' このサンプルはアプリケーション レベルの BeginFileDrop イベントで割り込みます。
    ' このイベントは、図面ファイルが AutoCAD にドラッグされたときに引き起こされます。
    ' このイベントを引き起こすには、
    '     1) サンプルの初期化を必ずしてください。
    '        Public 変数(ACADApp という名前)をこのイベントにリンクしてください。
    '     2) AutoCAD にファイルをドラッグしてください。
    
    Dim FS As FileSystemObject
    Set FS = CreateObject("Scripting.FileSystemObject")
    
    If FileName Like "*.dvb" Then
        LoadDVB FileName
        Dim strModule As String
        strModule = FS.GetBaseName(FileName)
        
        On Error Resume Next        ' エラーのトラップを留保します。
        RunMacro strModule & ".ThisDrawing.ACADStartup"
        Err.Clear                   ' エラーが発生した場合は Err オブジェクトをクリアします。
    End If
End Sub

(2005年1月 7日)

「VBAの自動実行 Part1」につづく・・・。
ċ
mura,
2010/06/11 15:55
ą
mura,
2010/06/11 19:15
Comments