为什么一个框就能过滤掉，两个就不能？
'想把绿色的线组成的框内的块过滤掉，明明程序设置了几个绿色的框都可以，但运行之后一个框时才能过滤掉'如果俩绿色框就过滤不掉了，整个图纸的块都选择了？ 求解释？？？？？？？？？？？？？？？？？？
'本思路是取得块的插入点，很小半径做面域；绿色框变面域；然后点变的面域与每个面域做交集，每次做完，交集面积相加，等于原来的2倍（与自己做一次，与包围他的绿色框一次，不存在框套框现象），判断为在绿色框内。
Function binskid(ByVal Point) As Boolean
Dim ent1 As Object
Dim obname As String
'Dim Point As Variant
binskid = True
On Error Resume Next
'''''''''''''''
'''''''''''''''将绿色的撬变为面域
Dim ss_skid As AcadSelectionSet ', ent As AcadEntity
Dim regionObj As Variant
Dim dxf_code() As Integer, dxf_value() As Variant
Dim greenline() As AcadEntity
On Error Resume Next
Set ss_skid = ThisDrawing.SelectionSets("ssLine1")
If Err Then Set ss_skid = ThisDrawing.SelectionSets.Add("ssLine1")
ss_skid.Clear
ReDim dxf_code(0), dxf_value(0) ' 过滤条件
dxf_code(0) = 62: dxf_value(0) = 3 '颜色的dfx组码是62，绿色的值是3
ss_skid.Select acSelectionSetAll, , , dxf_code, dxf_value
ReDim greenline(ss_skid.Count - 1)
For intCnt = 0 To ss_skid.Count - 1
Set greenline(intCnt) = ss_skid.Item(intCnt)
Next
Set regionObj = ThisDrawing.ModelSpace.AddRegion(greenline)
'''''''''''''''''''
'将点变为面域
Dim pRegion As Variant
Dim pobjs(0) As AcadEntity
Set pobjs(0) = ThisDrawing.ModelSpace.AddCircle(Point, 0.0001)'将点画圆
Set pRegion = ThisDrawing.ModelSpace.AddRegion(pobjs)(0)'将圆设置为面域
kk = 2 * pRegion.Area
'MsgBox pRegion.Area
'MsgBox kk
pobjs(0).Delete ''''''''''''''''圆删除
Dim pRegion1 As AcadEntity
Set pRegion1 = pRegion
'''''''''''''''''''''''''''选择图中所有面域
Dim mian(5)As AcadEntity
i = 0
For Each ent1 In ThisDrawing.ModelSpace '在模型空间里循环
obname = ent1.ObjectName '提取对象类型
'MsgBox obname
If obname = "AcDbRegion" Then '判断对象是否为面域
Set mian(i) = ent1
'MsgBox mian(i).Area
i = i + 1
End If
Next
''''''''''''''''''''''
''''''''''''''''''点的面域与每个面域做交易，面积相加，如果面积等于原来两倍，说明在内，否则在外
''''''''''''''''橇的面域在做交集的时候删除了
summianji = 0
For j = 0 To i - 1
pRegion1.Boolean acIntersection, mian(j)
summianji = summianji + pRegion1.Area
Set pRegion1 = pRegion
Next
If summianji = kk Then binskid = False 'false代表在面内
pRegion1.Delete
End Function
页:
[1]