不确定我明白你想做什么...你想在列表中选择的布局中进入纸空间吗?如果是这样,当您从列表中选择多个布局时,您会产生问题。
我之前提到过,您可以将标题块过滤到选择集中,并且只对您选择的块进行操作。
如果块存在,此实用程序将返回它,否则它不返回任何内容。在对其进行操作之前,您必须验证块是否确实存在。
- Function GetBlockReferenceByLayout(ByVal strBlockName As String, ByVal strLayoutName As String) As AcadBlockReference
- 'setup variables
- Dim BLCollect As AcadSelectionSet
- Dim BlkRef As AcadBlockReference
- Dim GCode(1) As Integer
- Dim GData(1) As Variant
- Dim GPCode As Variant
- Dim GPData As Variant
- 'filter for selection set
- GCode(0) = 0
- GData(0) = "Insert"
- GCode(1) = 2
- GData(1) = strBlockName
- GPCode = GCode
- GPData = GData
- 'create selection set
- Set BLCollect = ThisDrawing.SelectionSets.Add("BLOCKREF")
- 'add items to selection set
- BLCollect.Select acSelectionSetAll, , , GPCode, GPData
- 'loop through all items in selection set
- For Each BlkRef In BLCollect
- 'compare layout name
- If UCase(ThisDrawing.ObjectIdToObject(BlkRef.OwnerID).layout.Name) = UCase(strLayoutName) Then
- 'return the reference
- Set GetBlockReferenceByLayout = BlkRef
- Exit For 'exit the 'for' loop since we have the title block. This assumes only a single block in each layout
- End If
- Next BlkRef
- 'delete the selection set
- BLCollect.Delete
- 'clear the variable
- Set BLCollect = Nothing
- End Function
用法应采用以下格式...
- Dim blkObject As AcadBlockReference
- Set blkObject = GetBlockReferenceByLayout("titleblock", "layout1")
- If blkObject = Nothing Then
- MsgBox "titleblock was not found in layout1"
- Else
- 'do other stuff here to blkObject
- End If
|