下面的两种方法都可以实现:
- Sub Test1()
- Dim BlockRefObj As AcadBlockReference
- Dim EntObj As AcadEntity
-
- Dim BlockName As String
- BlockName = "块名"
-
- '遍历模型空间,判断实体的类型。如果是块,判断块名。
-
- For Each EntObj In ThisDrawing.ModelSpace
- If TypeOf EntObj Is AcadBlockReference Then
- Set BlockRefObj = EntObj
- If BlockRefObj.Name = BlockName Then
- Debug.Print "插入点位置: " & BlockRefObj.InsertionPoint(0) & BlockRefObj.InsertionPoint(1)
- End If
- End If
- Next
- End Sub
- Sub Test2()
- Dim BlockRefObj As AcadBlockReference
- Dim EntObj As AcadEntity
- Dim SSetObj As AcadSelectionSet
-
- Dim BlockName As String
- BlockName = "块名"
-
- '使用过滤机制,全部选中指定名称的块。
-
- On Error Resume Next
- Set SSetObj = ThisDrawing.SelectionSets("Test")
- If Err Then
- Err.Clear
- Set SSetObj = ThisDrawing.SelectionSets.Add("Test")
- End If
- SSetObj.Clear
- On Error GoTo 0
-
- Dim GroupCode(0 To 1) As Integer
- Dim DataValue(0 To 1) As Variant
- GroupCode(0) = 0
- DataValue(0) = "INSERT"
- GroupCode(1) = 2
- DataValue(1) = BlockName
-
- SSetObj.Select acSelectionSetAll, , , GroupCode, DataValue
- For Each EntObj In SSetObj
- Set BlockRefObj = EntObj
- If BlockRefObj.Name = BlockName Then
- Debug.Print "插入点位置: " & BlockRefObj.InsertionPoint(0) & BlockRefObj.InsertionPoint(1)
- End If
- Next
- End Sub
|