Autodesk Community Tips- ADNオープン
Autodesk Community Tipsではちょっとしたコツ、やり方、ショートカット、アドバイスやヒントを共有しています。

AutoCAD VBA:ブロック名パターンを使ったブロックの取得

Issue

VBA マクロで特定のブロック名パターンを持つブロックのブロック属性を得たいのですが、可能でしょうか?

例えば、図面内の A で始まるブロック名を持つすべてのブロックのみを対象にする、といった方法です。

 

Solution

特定のブロック名パターンに検索には、選択セットのフィルタ リストにアスタリスク記号でワイルドカード(*を組み合わせて指定することが出来ます。A で始まるブロック名を持つブロックは、A* で指定可能です。

 

次のコードは、ワイルドカードを含めたブロック名パターンを指定して、対象ブロック参照を取得、ブロック属性の有無をチェックして、ブロック属性が含まれる場合に属性のタグと値を表示するものです。なお、*fix**tub など、ワイルドカードはブロック名中、どこに置いても指定することが出来ます。

 

Public Sub GetBlockAttribute2()

    On Error Resume Next

    Dim sset As AcadSelectionSet
    ThisDrawing.SelectionSets.Item("ssblocks").Delete
    Set sset = ThisDrawing.SelectionSets.Add("ssblocks")
   
    ThisDrawing.Utility.InitializeUserInput NoNull
    returnString = ThisDrawing.Utility.GetString(True, "対象のブロック名を入力 [すべて (*) ] : ")
    If returnString = "" Then
        returnString = "*"
    End If
    
    Dim FilterType(1) As Integer
    Dim FilterData(1) As Variant
    FilterType(0) = 0
    FilterData(0) = "Insert"
    FilterType(1) = 2
    FilterData(1) = returnString
    sset.Select acSelectionSetAll, , , FilterType, FilterData
    
    If sset.Count > 0 Then
        Dim ent As AcadEntity
        For Each ent In sset
            Dim blkRef As AcadBlockReference
            Set blkRef = ent
            
            ThisDrawing.Utility.Prompt vbCrLf & blkRef.Name & " ブロック参照が検出されました."
            
            Dim varAttributes As Variant
            varAttributes = blkRef.GetAttributes

            If UBound(varAttributes) < 0 Then
                ThisDrawing.Utility.Prompt vbCrLf & " ブロック参照に属性がありません..."
            Else
                Dim strAttributes As String
                For Each blkAttr In varAttributes
                    strAttributes = ""
                    strAttributes = strAttributes & "  タグ名: " & blkAttr.TagString & " - 属性値 " & blkAttr.TextString & vbLf & "    "
                    ThisDrawing.Utility.Prompt vbCrLf & strAttributes
                Next
            End If
        Next
    Else
            ThisDrawing.Utility.Prompt vbCrLf & returnString & " ブロック名パターンに合致するブロック参照がありません..."
    End If

End Sub

 

次の例では、ブロック名パターン * で全ブロックのブロック属性を、A* で A で始まるブロック名を持つブロック参照のブロック属性を表示しています。

 

block_search.gif