arden 发表于 2005-12-7 17:36:00

[VBA]关于选择集

<P>我想用一闭合多段线为边界选择其内部的图形,采用selectbypolygen方法,但发现与边界相连的多边形或线段都选不上,如下图,有其它方法吗?</P>
<P>d:\未命名.bmp</P>

莫名 发表于 2005-12-7 22:27:00

<P class=syntax>object.SelectByPolygon Mode, PointsList, FilterType, FilterData
<P class=element>Mode用acSelectionSetCrossingPolygon </P>

arden 发表于 2005-12-8 14:48:00

<P><A name=73150><FONT color=#990000><B>莫名</B></FONT></A>你好，如果Mode采用acSelectionSetCrossingPolygon 的话与边界相连的外面的多边形也会被选中。我主要是用来计算图斑面积时扣除内部图斑的面积，不知有没有好一点的办法。</P>
<P>d:\未命名.bmp</P>

arden 发表于 2005-12-22 13:37:00

沉到底了，自己顶一下，大家给个答案啊

arden 发表于 2006-1-4 14:41:00

自己顶

arden 发表于 2006-1-5 14:57:00

<P></P>
<P>程序如下:<BR>Sub selectPl()<BR>&nbsp;&nbsp;&nbsp; Dim ent As AcadEntity<BR>&nbsp;&nbsp;&nbsp; Dim SelObj As AcadEntity<BR>&nbsp;&nbsp;&nbsp; Dim NumSel As Integer<BR>&nbsp;&nbsp;&nbsp; Dim Coord As Variant<BR>&nbsp;&nbsp;&nbsp; Dim CoordCount As Integer<BR>&nbsp;&nbsp;&nbsp; Dim NewCoord() As Double<BR>&nbsp;&nbsp;&nbsp; Dim i As Integer<BR>&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp; Dim ssetObj As AcadSelectionSet<BR>&nbsp;&nbsp;&nbsp; On Error GoTo Err1:<BR>&nbsp;&nbsp;&nbsp; Set ssetObj = ThisDrawing.SelectionSets.Add("TEST_SSET2")<BR>&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp; On Error Resume Next<BR>&nbsp;&nbsp;&nbsp; Do<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ThisDrawing.Utility.GetEntity ent, pnt, "选择多段线："<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If Err Then Exit Sub<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If TypeName(ent) Like "IAcad*Polyline" Then Exit Do<BR>&nbsp;&nbsp;&nbsp; Loop<BR>&nbsp;&nbsp;&nbsp; <BR>If TypeName(ent) = "IAcadLWPolyline" Then<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Coord = ent.Coordinates <BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; CoordCount = (UBound(Coord) + 1) / 2 '顶点数<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '定义新的顶点坐标数组<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ReDim NewCoord(0 To (3 * CoordCount - 1)) As Double<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; For i = 0 To UBound(Coord) - 1 Step 2<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; NewCoord((3 * i) / 2) = Coord(i)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; NewCoord((3 * i) / 2 + 1) = Coord(i + 1)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; NewCoord((3 * i) / 2 + 2) = 0<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Next i<BR>ElseIf TypeName(ent) = "IAcadPolyline" Then<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Coord = ent.Coordinates<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; CoordCount = (UBound(Coord) + 1) / 3<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ReDim NewCoord(0 To UBound(Coord)) As Double<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; For i = 0 To UBound(Coord) - 1<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; NewCoord(i) = Coord(i)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; NewCoord(i) = Coord(i)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; NewCoord(i) = Coord(i)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Next</P>
<P>End If<BR>ssetObj.SelectByPolygon acSelectionSetWindowPolygon, NewCoord<BR>ssetObj.Highlight True<BR>ssetObj.Update<BR>NumSel = ssetObj.Count<BR>Exit Sub<BR>Err1:<BR>&nbsp;&nbsp;&nbsp; ThisDrawing.SelectionSets.Item("TEST_SSET2").Delete<BR>&nbsp;&nbsp;&nbsp; Resume<BR>End Sub</P>

arden 发表于 2006-1-10 20:00:00

还是自己顶,有人回答一下是如果根本没办法解决有话就不顶了
页: [1]
查看完整版本: [VBA]关于选择集