Autodesk Community Tipsではちょっとしたコツ、やり方、ショートカット、アドバイスやヒントを共有しています。
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 で始まるブロック名を持つブロック参照のブロック属性を表示しています。