前回の
Bricscad VBAを使ってみよう[4]　VBAの基本コード①
からの続篇です。

VBAを使用する(使用したい)目的は、条件分岐と繰り返し処理により複雑な処理が可能になり、多量のﾃﾞｰﾀｰを扱う場合でExcelとデーターのやり取りができることにあります。

今回は、条件分岐と繰り返しに関してですが、特に、VBAのコード作成で重要な「On Error Resume Next」を踏まえて検討しました。

１，条件分岐処理

複数の条件によって処理を分岐する場合、
IfステートメントとSelect Caseステートメントを用います。

１，Ifステートメント

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

If   A(評価1）Then
（処理1）
ElseIf　A(評価2）Then
（処理2）
Elseif　A(評価3）Then
（処理3）
Else
(それ以外の処理）
End If

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

評価に使用する演算子

比較演算子
（例）
If A = 0 Then・・・・
等しい=、より大>、より小<、以上>=、以下<=、ではない<>
これは有りません><

Ａnd演算子
（例）
If A > 0 And  B > 0 Then・・・・

Or演算子
If A > 0 Or  B > 0 Then・・・・

2，Select Caseステートメント

Ifステートメントと同様に使える

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

Select Case　A
Case   (評価1）
（処理1）
Case   (評価2）
（処理2）
Else
(それ以外の処理）
End If

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

Select Caseでは、toで範囲の指定や固定値のみの記述もでき、行数が多い程可読性が高い

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

Select Case　A
Case  0  to 10
（処理1）
Case   11 to 20
（処理2）

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

Select Case　A
Case  10
（処理1）
Case   20
（処理2）

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

ここは、さらりと通り過ぎます＾＾

２，繰り返し処理

１，繰り返し処理

条件を満たすまで処理を繰り返す
Do ・・・Loopステートメント

と、・・・

回数を指定して処理を繰り返す
For・・・Nextステートメント

コレクションの各要素に対して処理を繰り返す
For Each・・・Nextステートメント
があります。

Exitステートメント
ループやプロシージャから抜けるときに使用します。
Exit (Do/For/Sub/Function)

 

２，On Error Resume Next

 

エラーが発生しても、無視して突き進む、On Error Resume Next　は、VBAのコード作成に重要です。

プロシージャからExit Subする場合にESCキーを使用しますが、エラー処理が必須になります。

順を追って確認してみます。

下記コードは１回クリックして半径100の円を描きます。

Sub Sample_1()

Dim insPt() As Double

    insPt = ThisDrawing.Utility.GetPoint(, "挿入点をクリック: ")

Dim myCircle As AcadCircle
    Set myCircle = ThisDrawing.ModelSpace.AddCircle(insPt, 100)

End Sub

 

 

 

円を一つだけ描いて終了します。

もう一度やろうと思って・・・再度実行・・・画面をクリック時に、気が変わってESCキーで終了・・・・するつもりが・・・

VBAのダイアログが、エラーですよ～と「Debug」ボタンを強調して出てきます。

実行時エラー -2147467259 (80004005)
GetPointオブジェクトのメソッドを失敗しました

Escキーのときに、GetPointがエラー番号-2147467259でストップしました。

このようにESCキー操作でエラー警告が出て停止して終了処理ができない状態になりました。

 

そこで、On Error Resume Next　が必要になります。

 

On Error Resume Next　は、
エラー発生時に時に、エラー発生行を飛び越えて次の行に進みます。

 

Sub Sample_2()

On Error Resume Next

Dim insPt() As Double

    insPt = ThisDrawing.Utility.GetPoint(, "挿入点をクリック: ")

    MsgBox Err.Number

Dim myCircle As AcadCircle
    Set myCircle = ThisDrawing.ModelSpace.AddCircle(insPt, 100)

End Sub

エラー行を無視して次に進んで、Msgboxが出てエラー番号が表示されました。

不特定の回数で繰り返し処理を行う場合は、Do･･･Loopステートメントを使用しますが、ループから抜ける時のESCキー操作時のエラーで、ストップせずに進ませるために、On Error Resume Next　を使用します。

そして、このMsgBoxの代わりに、If Err Then・・・、If  Err.number <> 0 Then・・・のエラー判定の処理が必要になります。
If Err Then Exit sub で終了することができますが、実際は終了時の行う処理を追加します。

On Error Resume Next ステートメントは、

エラーの原因となった行を無視し次の行に実行の制御を移し、実行はOn Error GoTo 0 まで中断されません。

 

On Error GoTo 0 ステートメントは、

プロシージャ内でのエラー処理On Error Resume Nextを無効にします。
Err オブジェクトのプロパティをリセットするので、 Err オブジェクトの Err.Clearメソッドと同じ効果があります。

 

３，Errオブジェクト

エラーの情報は、Errオブジェクトに格納されます。

Err オブジェクトの既定のプロパティは、Number です。
Numberプロパティはエラーの種類で割り振られた番号で、どんなエラーが発生したかを調べることができます。

Description プロパティは、エラーの簡単な説明で構成されます

ESCキー操作時は、Err.Number = -2147467259 でした。
エラーでない場合は、Err.Number = 0 です。
その他のエラー時にも、エラーの種類を識別する番号が格納されます。

Err オブジェクトのプロパティは、エラー処理ルーチン内の Exit Sub、Exit Function、Exit Property、または Resume Next ステートメントの後で 0 または長さ 0 の文字列 (“”) にリセットされます。

エラー処理ルーチン外で Resume ステートメントのいずれかの形式を使用した場合、Err オブジェクトのプロパティはリセットされません。 Err を明示的にリセットするには、Clear メソッドを使用できます。

 

４，エラー処理ルーチン

On Error ステートメントで、エラー処理ルーチンを有効にします。

エラーが発生した時・・・は、
If Err Then・・・もしくは、If  Err.number <> 0 Then・・・
でエラー発生後に行う処理を記述します。

Sub Sample_3()

Do
    On Error Resume Next

    Dim insPt() As Double
    insPt = ThisDrawing.Utility.GetPoint(, "挿入点をクリック: ")

    If Err.Number <> 0 Then
        If Err.Number = -2147467259 Then
            MsgBox "ESCｷｰが押されました"
            Exit Sub
        Else
            Exit Sub
        End If
    End If

    Dim myCircle As AcadCircle
    Set myCircle = ThisDrawing.ModelSpace.AddCircle(insPt, 100)

    On Error GoTo 0
Loop

End Sub

連続処理が可能になり、ESCキーで終了できるようになりました。

 

3，エラー処理ルーチンでの分岐処理

前回の同心円作図で、追加する円の数をWin32APIを用いて、テンキーから取得しましたが、今回は、.Utility.GetReal　と　InputBox　の２パターンで検討してみました。

ユーザーフォームを使用せずに、ESCキーで「同心円の数の設定」と「終了」を選択できるようにしました。

GetRealのテンキー入力の場合

ESCキーで、同心円：はい、終了：いいえ

無くてもいいが、テンキー入力の表示

ここでは、３を入力しEnter

入力時全角では入らないので、操作中に半角に切り替えてOK

 

Sub Sample_4()

''オートコンプリートの現在値を取得
Dim GetATComp As String
GetATComp = ThisDrawing.GetVariable("AUTOCOMPLETEMODE")

''オートコンプリートを無効にする
ThisDrawing.SetVariable "AUTOCOMPLETEMODE", "0"

Do

On Error Resume Next


Dim insPt() As Double
insPt = ThisDrawing.Utility.GetPoint(, "挿入点をｸﾘｯｸ【ESCｷｰ/終了or同心円】: ")

If Err.Number <> 0 Then
    
    If Err.Number = -2147467259 Then
        
        Dim ErRet As VbMsgBoxResult
            ErRet = MsgBox("「はい：同心円設定」「いいえ：終了」", vbYesNo + vbQuestion)
            If ErRet = vbYes Then
                MsgBox "同心円の+数をテンキー入力", vbInformation
                Err.Clear
                Dim keynum As Long
                keynum = ThisDrawing.Utility.GetReal("ﾃﾝｷｰ入力/Enter:")
            Else
                ''終了する
                ''オートコンプリートの設定を戻す
                ThisDrawing.SetVariable "AUTOCOMPLETEMODE", GetATComp
                On Error GoTo 0
                Exit Sub
            End If
        
    Else
        ''オートコンプリートの設定を戻す
        ThisDrawing.SetVariable "AUTOCOMPLETEMODE", GetATComp
        On Error GoTo 0
        Exit Sub
    End If

Else

    Dim myCircle As AcadCircle
        Set myCircle = ThisDrawing.ModelSpace.AddCircle(insPt, 100)
    
    ''円の間隔を文字高さの1/10にする
    Dim offsetObj As Variant, i As Long
    If keynum > 1 Then
        For i = 1 To keynum
        offsetObj = myCircle.Offset(100 / 10 * i)
        Next
    End If
        
    '作図図形範囲にZoom
    ThisDrawing.Application.ZoomExtents
    '図面を更新
    ThisDrawing.Application.Update

End If

On Error GoTo 0
Loop


End Subぜ

（注意点）

全角半角は自動で処理しませんので、半角を確認してください。

同心円用の数値入力時の入力値が特に2.3は、オートコンプリートで使えないので、システム変数の現在値を取得し変数に格納後、システム変数を”0”で無効にします。終了時に元の値に戻します。

オートコンプリートの現在値を取得
Dim GetATComp As String
GetATComp = ThisDrawing.GetVariable(“AUTOCOMPLETEMODE”)
オートコンプリートを無効にする
ThisDrawing.SetVariable “AUTOCOMPLETEMODE”, “0”
オートコンプリートの設定を戻す
ThisDrawing.SetVariable “AUTOCOMPLETEMODE”, GetATComp

使われる場合は、念のため　「AUTOCOMPLETEMODE」　の現在値を確認しておいてください。多分触っていなければ47です。

InputBoxからの入力の場合

InputBoxではオートコンプリートを無効にする必要はありません。
（BricsCADのコマンドバーでオートコンプリートが機能しています）

テンキー入力がInputBox入力に変りました。

コードもあっさりします。

Sub Sample_4()

Do

On Error Resume Next


Dim insPt() As Double
insPt = ThisDrawing.Utility.GetPoint(, "挿入点をｸﾘｯｸ【ESCｷｰ/終了or同心円】: ")

If Err.Number <> 0 Then
    
    If Err.Number = -2147467259 Then
        
        Dim ErRet As VbMsgBoxResult
        
            ErRet = MsgBox("「はい：同心円設定」「いいえ：終了」", vbYesNo + vbQuestion)
            If ErRet = vbYes Then
                Err.Clear
                Dim keynum As Long
                keynum = InputBox("半角整数を入力", "同心円 + 数設定", "")
            Else
                ''終了する
                On Error GoTo 0
                Exit Sub
            End If
        
    Else
        On Error GoTo 0
        Exit Sub
    End If

Else

・・・・以下同じ

 

上にあがるResumeやGoTo文も検討しましたが、どーしても前回描画の円をOffsetするのでやめました。

 

その他

繰り返し処理で、

Do ・・・Loopステートメント
Do Until・・・Loop
Do・・・Loop Until
Do While・・・Loop
Do・・・Loop While
や
For・・・Nextステートメント
For Each・・・Nextステートメント
がありますが、

とくにここではこれ以上は触れませんが、

 

コレクションの各要素に対して処理を繰り返す
For Each・・・Nextステートメントは、画層リスト取得にちょうどぴったりです。

画層数は図面ごとに異なります。 Layers コレクションから全画層名を取得しComboBoxに格納します。

Private Sub UserForm_Initialize()

'全画層名をComboBoxLayに格納
    Dim LayObj As AcadLayer
    For Each LayObj In ThisDrawing.Layers
        ComboBoxLay.AddItem LayObj.Name
    Next
    ComboBoxLay.Value = ThisDrawing.ActiveLayer.Name
    
End Sub

 

ユーザーフォームで、わざわざ現在層を変える必要もないんですが・・

Private Sub CmdCancel_Click()

    Unload Me

End Sub

Private Sub CmdOK_Click()

    ''変数を宣言
    Dim CurLay, SelLay As String
    ''現在画層名
    CurLay = ThisDrawing.ActiveLayer.Name
    ''選択画層インデックス
    SelLay = ComboBoxLay.List(ComboBoxLay.ListIndex)
    
    ThisDrawing.SetVariable "CLAYER", SelLay
    
    MsgBox "現在画層を" & SelLay & "に変更しました"
    
End Sub

Private Sub ComboBoxLay_Change()

    With ComboBoxLay
        SelLay = .ListIndex
    End With


End Sub

Private Sub UserForm_Initialize()

'全画層名をComboBoxLayに格納
    Dim LayObj As AcadLayer
    For Each LayObj In ThisDrawing.Layers
        ComboBoxLay.AddItem LayObj.Name
    Next
    ComboBoxLay.Value = ThisDrawing.ActiveLayer.Name
    
End Sub

 

今後の予定は・・・

Excelとの連携です。

 

 

coffee break

VBAはExcelのVBAで数字を扱うことはしていましたので、VBA自体の構文には特に違和感は有りません。しかし、BricsCADの作図でVBAの利用は初めての取り組みで、しばらくは下調べに時間を費やしていました。

調べだすと、どんどんと広がってキリがなくなりますが、取り敢えずは必要そうなものを使えるようにしていけば、塵も積もれば山となりますね。

 

BricsCAD VBAを使ってみよう　INDEX

BricsCAD VBAを使ってみよう[1]　VBAのｲﾝｽﾄｰﾙ

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

BricsCAD VBAを使ってみよう[3]　UserFormその２
「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

 

以下検討中です。

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