如何在获取选择集中多个块的插入点?

jsnjwang

Sub PrintModelSpace()
On Error Resume Next
Dim insert_x As Double, insert_y As Double, xscl As Single
Dim FilterType(0) As Integer
Dim FilterData(0) As Variant
Dim ii As Integer
Dim attributeobj As AcadAttribute
Dim obj As AcadBlockReference
Dim var As Variant
FilterType(0) = 2
FilterData(0) = "tk"
Dim sel As AcadSelectionSet '选择集
Set sel = ThisDrawing.SelectionSets.Add("ssel")
If Err Then
Err.Clear
ThisDrawing.SelectionSets("ssel").Delete
Set sel = ThisDrawing.SelectionSets.Add("ssel")
End If
sel.Select acSelectionSetAll, , , FilterType, FilterData
For ii = 1 To sel.Count
Set obj = sel.Item(ii)
insert_x = obj.InsertionPoint(0)
insert_y = obj.InsertionPoint(1)
xscl = obj.XScaleFactor
Next ii
End Sub 以上程序是想在图中选择块名为tk的块,然后分别获得每个块的插入点和X比例,但是只能得到第一个块名为tk的插入点和X比例,为什么?有没有人能帮帮我??

laoliu09

你应该先用选择集选择图形上所有的图块，然后再判断块名是不是“tk”。

jsnjwang

能不能给些代码?还有,有很可能图块很多,这样一来会使会速度很慢,而且效率也不是很高.

雪山飞狐_lzh

Sub tt3()
On Error Resume Next
Dim ss As AcadSelectionSet
Dim ft(1) As Integer, fd(1)
Dim obj As AcadBlockReference
ft(0) = 0: fd(0) = "Insert"
ft(1) = 2: fd(1) = "tk"
ThisDrawing.SelectionSets("Test").Delete
Set ss = ThisDrawing.SelectionSets.Add("Test")
ss.Select acSelectionSetAll, , , ft, fd
For Each obj In ss
insert_x = obj.InsertionPoint(0)
insert_y = obj.InsertionPoint(1)
xscl = obj.XScaleFactor
Next obj
End Sub