BricsCAD VBAを使ってみよう[3] UserFormその2

前回の、
BricsCAD VBAを使ってみよう[2] UserFormその1
からの続篇です。

今回は、連番記入コマンドの作成手順と、VBマクロ実行の「VbaRun」と「-VbaRun」コマンドです。

1,UserFormの構成

操作は、挿入基点をクリックすると・クリックした位置に・ユーザーフォームに設定した文字の大きさで自動的にカウントアップしながら連番を連続して記入していく・・

という操作ができるように作成しました。

①UserFormの構成を検討

ユーザーフォームを使用して、どのような作業を行うかを計画します。

OK・Cancelボタンは必須です。
連番の「開始番号」「文字の大きさ」の設定
追加で、「桁ぞろえは3桁まで選択できる」「2重円の作図も選択できる」

としました。

その動作を行うために必要な部品を、Toolboxからドラックして配置します。

(Name)は部品が多くなると、どれがどこの??状態になりますので判別しやすいように変更しました。

UserFormの部品の(Name)を変更しています。

変更前 変更後
ChekBox1 CheckBoxWL
TextBox1 TextBoxString
CobboBox1 ComboBoxKeta
TextBox1\2 TextBoxTxtHi
CommandButton1 CmdOK
CommandButton2 CmdCance

もっと短くあっさりでもいいんですが・・・・とりあえず
Captionは以下フォームのようにしました。

②UserFormの部品のコード作成

OK、Cancelボタンの実行コードを前回同様に作成します。(OKボタン内は実際の動作のコードを後で作成します)

===============

コンボボックスの設定
UserForm_Initialize

With ComboBoxKeta
AddItem “1”
.AddItem “01”
.AddItem “001”
End With
ComboBoxKeta.Value = “1”
としました。

===============

ユーザーフォーム表示時初設定
UserForm_Activate

”ダイアログ表示時のフォーカス位置
TextBoxString.SetFocus
”ダイアログ表示の時初期値
If RSNum = 0 Then TextBoxString.Value = 1
TextBoxTxtHi.Value = 100

とし、No1から開始、文字高100としました。

 

2,VBAマクロのコードの作成

OKボタンの、Private Sub CmdOK_Click()・・・End Sub内に、OK後に行う動作のコードを記述します

コードの骨格部分は以下としています。

===================

Private Sub CmdOK_Click()
【フォームを隠す】
Me.Hide
【作図実行】
 Do
  【エラー時にも継続する】
  On Error Resume Next
  ■作図の中心点をクリック
【キャンセルの場合】
  If Err Then
   【エラー処理を元に戻す】
     On Error GoTo 0
   【ユーザーフォーム再表示】
Me.Show
Exit Sub
  End If
  ■作図実行
‘エラー処理を元に戻す
On Error GoTo 0
 Loop
End Sub

===================

Do ・・・・Loop による繰り返し動作のため、
選択のため待機するコマンド(.Utility.GetPoint)+ Escキーで中断Exit Sub(If Err Then)としています。
OKボタン以外に

Cancelボタン
Private Sub CmdCancel_Click()

コンボボックスの設定値
Private Sub UserForm_Initialize()

ユーザーフォームダイアログ表示時の設定
Private Sub UserForm_Activate()

がUserForm1のVBマクロのコードになります。

‘■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
【確認環境】
Windows10(64bit)
CADバージョン BricsCAD pro V20 (64bit)
本コードは、ご参考でお扱ください。
‘■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■

Option Explicit
    ''連番再開Noの変数はここで宣言
    Dim RSNum As Integer

Private Sub CmdCancel_Click()
    ''ダイアログ終了
    Unload Me

End Sub

Private Sub CmdOK_Click()

''【変数宣言】
''連番開始No
    Dim StartNum As Integer
''連番カウントアップ
    Dim Countup As Integer
''連番カウントアップ初期化
    Countup = 0
''連番カウントアップ初期化
    RSNum = 1
''二重円
 Dim ChWL As Boolean
''【開始番号初期値取得】
    StartNum = Val(TextBoxString.Text)

''フォームを隠す
    Me.Hide

''【作図実行】
Do

''エラー時にも継続する
On Error Resume Next
''●挿入基準点を指示
    Dim varPnt() As Double
    varPnt = ThisDrawing.Utility.GetPoint(, "連番挿入点をクリック: ")
    'キャンセルの場合
        If Err Then
            ''エラー処理を元に戻す
            On Error GoTo 0
            ''ユーザーフォーム再表示
            Me.Show
            ''次回開始連番をセット
            TextBoxString.Value = RSNum
            Exit Sub
        End If

''挿入座標を変数に格納
    Dim insPt(0 To 2) As Double
    insPt(0) = varPnt(0): insPt(1) = varPnt(1): insPt(2) = varPnt(2)

''連番記入
    ''文字高さ
    Dim dHeight As Double
        dHeight = Val(TextBoxTxtHi.Text)
    Dim TextString As Integer
    Dim objText As AcadText
    ''開始No
    If Countup = 0 Then
        TextString = StartNum
    Else
        TextString = TextString + 1
    End If
    ''カウントアップ
    Countup = Countup + 1
    ''桁揃え
    Dim strString As String
        If ComboBoxKeta.ListIndex = 1 Then
            strString = Format(TextString, "00")
        ElseIf ComboBoxKeta.ListIndex = 2 Then
            strString = Format(TextString, "000")
        Else
            strString = TextString
        End If
    Set objText = ThisDrawing.ModelSpace.AddText(strString, insPt, dHeight)
    objText.Alignment = acAlignmentMiddleCenter
    ''桁数と文字幅の調整
    If Len(strString) = 2 Then
        objText.ScaleFactor = 0.8
    ElseIf Len(strString) = 3 Then
        objText.ScaleFactor = 0.6
    End If
    objText.TextAlignmentPoint = insPt
    ''ダイアログ連番表示用
    TextBoxString.Value = TextString + 1
    RSNum = TextString + 1
    
''円作図
    Dim myCircle As AcadCircle
    Set myCircle = ThisDrawing.ModelSpace.AddCircle(insPt, dHeight)
    ''2重円をoffsetで作図
    ChWL = CheckBoxWL.Value
    If ChWL = True Then
        Dim offsetObj As Variant
        ''円同士ののクリアランスを文字高さの1/10にする
        offsetObj = myCircle.Offset(dHeight / 10)
    End If

TextBoxString.Value = TextString + 1
    
''図面を更新
    ThisDrawing.Application.Update

''エラー処理を元に戻す
On Error GoTo 0

Loop

End Sub


Private Sub UserForm_Initialize()

    ''コンボボックスの設定値
    With ComboBoxKeta
        .AddItem "1"
        .AddItem "01"
        .AddItem "001"
    End With
    ComboBoxKeta.Value = "1"

End Sub

Private Sub UserForm_Activate()

    ''ダイアログ表示時のフォーカス位置
    TextBoxString.SetFocus
    ''ダイアログ表示時の初期値
    If RSNum = 0 Then TextBoxString.Value = 1
    TextBoxTxtHi.Value = 100

End Sub

作成中は、RunMacroボタンかF5キーで動作確認します。

・・・ですが、完成後はVBEからではなく直接ユーザーフォームのダイアログを表示する仕組みが必要になります。

 

3,実行時にユーザーフォームを表示するようにします

ユーザフォームから実行するためには、VBマクロ実行時にユーザーフォームが表示されるようにする必要があります。

ThisDrawingのコードウインドウに次のコードを書き入れます。

これが、ユーザーフォーム使用時のメインプロシージャとなります。

VBARUNでVBマクロ実行はこのプロシージャ名で呼び出すことになります。

作成したファイルを保存します。

「名前を付けて保存」の画面で、ファイル名が「default.dvb」になっています。毎回default.dvbでは困るのでファイル名を変更します。Renban.dvbでもいいんですがここでは,SerialNumber_1.dvb と変更しました。

dvbファイル保存用に、Dドライブに作成したVBAフォルダー内に保存しました。
コード作成中も同様に保存し、そのdvbファイルをCAD画面にドラッグするとロードされて、続きの作業ができます。

 

4,VBAプログラムの実行方法

VBAプログラムの作成中はVBEから動作確認しますが、完成したプログラムは、コマンドバー入力による「-VbaRUN」コマンドか、ダイアログボックスより実行する「VbaRUN」コマンドを使用します。

① -VbaRun [VBマクロ実行]

コマンドバーより、VBマクロを実行、作成、編集、削除します。

マクロがプロジェクトとモジュールの一部であれば(・・・は、只今作成中か、ロードされていればです)

 project.module.macro

DVBファイルがBricsCADにロードされていない時(・・・は、保存されているDVBファイルを保存場所から読み込む場合です)

 project.dvb!project.module.macro
(「PATH」/「DVBファイル名」)!(「モジュル名」,「メインルーチンのプロシージャ名」)
(「」()は、ここで見やすくするためで不要です)

ここで検討した例では、SerialNumber_1.dvbのファイルはDドライブ内のvbaフォルダーに保存し、UserForm1.ShowはThisDrawingにSerialNumber名のSubプロシージャ内に記述していますので、ユーザーフォームを呼び出すコードは下記になります。

-vbarun “D:/vba/SerialNumber_1.dvb!ThisDrawing.SerialNumber”

試しに、CADを新たに立ち上げて、コマンドバーにコードを張り付けてエンターで、VBAのコードが読み込まれてユーザーフォームのダイアログが表示されます。

実際の使用では、このコードをCUIファイルに登録して使用します。

手順は、BricsCAD のページをご参照ください。
部分CUIの作成し、コマンドを登録する手順

何が何でもCUIへ登録しなければいけないということでもありません。

② VbaRun [VBマクロ実行]

ダイアログボックスより、VBマクロを実行、作成、編集、削除します。 (-VbaRunはコマンドバー入力です。)

画面へdvbファイルをドラックか、ショートカットキー『Shift』+『F8』でプロジェクト管理画面から、dvbファイルをロード。

ショートカットキー『Alt』+『F8』で、下記画面を呼び出し、使用するVBAマクロを選択

ここでは、VBマクロは一つだけですが、一覧の中の該当VBAマクロを選択して実行できます。

次ページでは、VBAを使う上での基本的なコードを検討していきます。

 BricsCAD VBAを使ってみよう[4] VBAの基本コード①

 

 

coffee break

BricsCAD VBAは、Officeに搭載されているMicrosoft Visual Basicと同じものです。
Excel VBAは使うことがあり、そういうことではプログラミングに対して敷居は高く感じずに済みます。
多量のデーターを処理するために、Do ~LoopやSelectCaseで処理できることはとても魅力的です。
あとは、BricsCADのオブジェクトとしての記述構文の使い方を取得して使いこなせるようにしたいです。
連番では、円はすぐにできましたが、三角・四角・多角形では、 _rectang _polygon・・がVBAでは見当たらないんで、AddPolylineで作って下さぁい!ということですよね?

BricsCAD VBAを使ってみよう INDEX

BricsCAD VBAを使ってみよう[1] VBAのインストール

BricsCAD VBAを使ってみよう[2] UserFormその1
「BricsCAD VBA 」Creating UserForm

BricsCAD VBAを使ってみよう[3] UserFormその2
「BricsCAD VBA 」SerialNumber drawing with UserForm

BricsCAD VBAを使ってみよう[4] VBAの基本コード①

BricsCAD VBAを使ってみよう[5] VBAの基本コード②

BricsCAD VBAを使ってみよう[6] Excelとの連携①
「BricsCAD VBA to Excel」Get_CoordinateValues

BricsCAD VBAを使ってみよう[7] Excelとの連携② 
「Excel VBA to BricsCAD」Get_Area

BricsCAD VBAを使ってみよう[8] Excelとの連携②-2 
「Excel VBA to BricsCAD」Draw_ChannelSteel

BricsCAD VBAを使ってみよう[9] TABLEの自動作成と値入力
「BricsCAD VBA 」AutomaticCreation of TABLE

BricsCAD VBAを使ってみよう[10] Excelとの連携②-3
「Excel VBA to BricsCAD」SerialNumber_Ⅱ

BricsCAD VBAを使ってみよう[11] Excelとの連携②-4 
「Excel VBA to BricsCAD」Draw_Rectang

BricsCAD VBAを使ってみよう[12] Excelとの連携②-5 指定画層にOffset
「Excel VBA to BricsCAD」Continuous Offset to Specified Layer

BricsCAD VBAを使ってみよう[13] Excelとの連携②-6 指定画層にHATCH
「Excel VBA to BricsCAD」Continuous Hatch to Specified Layer

BricsCAD VBAを使ってみよう[14] Excelとの連携②-7 長さ計測
「Excel VBA to BricsCAD」Get Length

 

以下検討中です。

◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇
「この特集記事の内容につきましては、
こちらの環境のみの検討結果です。
動作保証は出来かねますため、ご参考
資料としてお扱いください。
Windows10(64bit)
BricsCAD pro V20(64bit)
Office2019(64bit)
◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇

 

カテゴリー: CAD