Issue
バルーン番号の番号部分を属性定義（タグ名 Index）したブロック定義（ブロック名 MyBlock）があります。
このブロック定義の挿入時にバルーン番号を加算しながら重複のないバルーン番号を持つブロック参照を配置することは可能でしょうか？
Solution
新たな MyBlock ブロック参照の挿入時に、モデル空間に配置されたすべての MyBlock を走査して Index タグ名を持つ属性値（文字列）を取得、最大値となり値をバルーン番号に設定することで実現することが出来るはずです。
次のサンプルは、MyBlock ブロック定義後に同処理を実装する VBA マクロの例です。属性値の妥当性チェックの処理はしていませんが、インデックス番号を保持するタグ名 Index を持つ属性には、半角整数の文字列が設定されているものとしています。IndexOnBlockRef プロシージャを実行してみてください。
' 挿入時に属性値（インデックス番号）を順番に割り当てるメイン プロシージャ
Public Sub IndexOnBlockRef()
Dim strBlkName
strBlkName = "MyBlock"
CreateBlockDef (strBlkName)
Dim insPt(0 To 2) As Double
insPt(0) = 0: insPt(1) = 0: insPt(2) = 0
Dim retPt As Variant
Dim index As Integer
Dim blockRefObj As AcadBlockReference
On Error Resume Next
Do
Err.Clear
retPt = ThisDrawing.Utility.GetPoint(, vbCrLf & "ブロックの挿入点を指示 : ")
If Err Then
Exit Do
End If
Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(retPt, strBlkName, 1#, 1#, 1#, 0)
index = FindMaxIndexAttribute()
Call SetIndexAttribute(blockRefObj, index + 1)
Loop
End Sub
' 属性定義（タグ名 Index）を含むブロック定義 MyBlock を定義する関数
Public Function CreateBlockDef(strBlkName As String)
Dim blockObj As AcadBlock
Dim insPt(0 To 2) As Double
insPt(0) = 0: insPt(1) = 0: insPt(2) = 0
On Error Resume Next
Set blockObj = ThisDrawing.Blocks.Item(strBlkName)
If Err Then
Set blockObj = ThisDrawing.Blocks.Add(insPt, strBlkName)
Dim circleObj As AcadCircle
Set circleObj = blockObj.AddCircle(insPt, 100#)
Dim attributeObj As AcadAttribute
Set attributeObj = blockObj.AddAttribute(100#, acAttributeModePreset, "インデックス？", insPt, "Index", "0")
attributeObj.Alignment = acAlignmentMiddleCenter
End If
End Function
' 与えられたブロック参照のタグ名 Index の属性値（整数）を返す関数
Public Function GetIndexAttribute(blockRefObj) As Integer
Dim varAttributes As Variant
varAttributes = blockRefObj.GetAttributes
Dim strAttribute As String
strAttribute = "-1"
For Each blockAttr In varAttributes
If blockAttr.TagString = "Index" Then
strAttribute = blockAttr.TextString
Exit For
End If
Next
GetIndexAttribute = CInt(strAttribute)
End Function
' モデル空間に配置されたすべての MyBlock ブロック参照を走査して割り当てられた最大の Index の属性値（整数）を返す関数う
Public Function FindMaxIndexAttribute() As Integer
Dim sset As AcadSelectionSet
On Error Resume Next
Set sset = ThisDrawing.SelectionSets.Item("ssblocks")
If Not Err Then
sset.Delete
End If
Set sset = ThisDrawing.SelectionSets.Add("ssblocks")
Dim FilterType(1) As Integer
Dim FilterData(1) As Variant
FilterType(0) = 0
FilterData(0) = "Insert"
FilterType(1) = 2
FilterData(1) = "MyBlock"
sset.Select acSelectionSetAll, , , FilterType, FilterData
Dim index As Integer
index = -1
Dim maxIndex As Integer
maxIndex = -1
If sset.Count > 0 Then
Dim entityObj As AcadEntity
For Each entityObj In sset
Dim blockRefObj As AcadBlockReference
Set blockRefObj = entityObj
index = GetIndexAttribute(blockRefObj)
If maxIndex < index Then
maxIndex = index
End If
Next
End If
FindMaxIndexAttribute = maxIndex
End Function
' 与えられたブロック参照1のタグ名 Index の属性値（整数）を設定する関数
Public Function SetIndexAttribute(blockRefObj, index)
Dim varAttributes As Variant
varAttributes = blockRefObj.GetAttributes
For Each blockAttr In varAttributes
If blockAttr.TagString = "Index" Then
blockAttr.TextString = CStr(index)
Exit For
End If
Next
End Function
既に挿入配置済のブロック参照 My Block に新たにインデクス番号の属性値を割り当てる場合には、前述のコードに次の AssignIndexToBlockRef プロシージャを追加・実行することでブロック参照を順に選択して値を更新することも出来ます。
' 配置済のブロック参照に指定値から属性値（インデックス番号）を順番に割り当てるメイン プロシージャ
Public Sub AssignIndexToBlockRef()
Dim strBlkName
strBlkName = "MyBlock"
Dim startIndex As Integer
startIndex = FindMaxIndexAttribute()
On Error Resume Next
Err.Clear
Dim returnInt As Integer
ThisDrawing.Utility.InitializeUserInput (4) ' disallow negative
returnInt = ThisDrawing.Utility.GetInteger(vbCrLf & "割り当てるインデクス開始値を入力<" & CStr(startIndex + 1) & "> : ")
If Err = 0 Then
If returnInt <= startIndex Then
MsgBox ("指定した値と同じ、または、大きいインデックス値を持つブロック参照が既に存在します" & vbCrLf & _
"既に配置済のブロック参照とインデックス値が重複してしまう可能性があります")
Exit Sub
End If
startIndex = returnInt - 1
End If
Dim returnObj As AcadObject
Dim basePnt As Variant
Do
Err.Clear
ThisDrawing.Utility.GetEntity returnObj, basePnt, "ブロック参照を選択:"
If Err = 0 Then
If returnObj.EntityName = "AcDbBlockReference" Then
Dim blockRefObj As AcadBlockReference
Set blockRefObj = returnObj
If blockRefObj.Name = strBlkName Then
startIndex = startIndex + 1
Call SetIndexAttribute(blockRefObj, startIndex)
End If
End If
Else
Exit Do
End If
Loop
End Sub
記事全体を表示
