[求助]选择集选取语法没错，为什么会漏选图元呢？求助高手！！
本帖最后由 作者 于 2008-3-18 20:53:25 编辑 <br /><br /> <p></p><p>检查了好几遍，没发现出问题，但是求不出所有的交点，是选择集出了问题，没有选取所以符合条件的图元。</p><p>至于为什么没有选到，就不知道了，求助高手啊。</p><p>语法应该没有问题</p><p><img alt="" src="http://img.blog.163.com/photo/5M38dcVBZ11zfqrFlHWjbw==/2331457232094829792.jpg" border="0"/></p><p>Private Sub CommandButton1_Click()</p><p><br/>On Error Resume Next<br/>UserForm1.Hide</p><p>'选择等高线<br/>Dim EntObj(0 To 0) As AcadEntity<br/>Dim PPt As Variant</p><p>ThisDrawing.Utility.GetEntity EntObj(0), PPt, "选择等高线: "<br/>If EntObj(0) Is Nothing Then Exit Sub</p><p>'求直线的外框<br/>Dim Pt1 As Variant<br/>Dim Pt2 As Variant<br/>EntObj(0).GetBoundingBox Pt1, Pt2</p><p>'创建选择集<br/>Dim ssetObj As AcadSelectionSet<br/>Set ssetObj = ThisDrawing.SelectionSets("SSET")<br/>If Err Then Set ssetObj = ThisDrawing.SelectionSets.Add("SSET")<br/>ssetObj.Clear</p><p>'只选取图层为DGX的图层<br/>'选择与该直线相交或者包含在外框中的所有实体<br/>Dim fType(0) As Integer<br/>Dim fData(0) As Variant</p><p>fType(0) = 8: fData(0) = "dgx"<br/>ssetObj.Select acSelectionSetCrossing, Pt1, Pt2, fType, fData</p><p><br/>'由于其中包含了自身实体，故应从选择集中移走<br/>'由于移去函数的参数是对象集合，所以在上面定义的是单个对象的对象集合<br/>ssetObj.RemoveItems EntObj</p><p><br/>Dim entTempElev As Double</p><p> entTempElev = EntObj(0).Elevation<br/>EntObj(0).Elevation = 0</p><p></p><p>'将等高线高程暂时化为0，原高程存储到数组elevTemp（）中<br/>Dim I As Integer</p><p>Dim elevTemp() As Double<br/>ReDim elevTemp(1 To ssetObj.Count)</p><p><br/>For I = 1 To ssetObj.Count<br/> elevTemp(I) = ssetObj.Item(I).Elevation<br/> ssetObj.Item(I).Elevation = 0<br/> ssetObj.Item(I).Update<br/>Next</p><p></p><p>'枚举交点，判断是否相交<br/>Dim pts As Variant<br/>Dim circle1() As AcadCircle<br/>ReDim circle1(ssetObj.Count - 1)<br/>Dim a As Integer</p><p>For I = 0 To ssetObj.Count - 1<br/> pts = ssetObj(I).IntersectWith(EntObj(0), acExtendNone)<br/> If Not IsEmpty(pts) Then<br/> Dim circleT(2) As Double<br/> circleT(0) = pts(0): circleT(1) = pts(1): circleT(2) = 0<br/> <br/> circle1(I) = ThisDrawing.ModelSpace.AddCircle(circleT, 0.5)</p><p> End If<br/>Next</p><p>EntObj(0).Elevation = entTempElev<br/>For I = 1 To ssetObj.Count<br/> ssetObj.Item(I).Elevation = elevTemp(I)<br/> ssetObj.Item(I).Update<br/>Next</p><p>UserForm1.Show<br/>End Sub</p> <p>我选择黑线,然后求得了交点:</p><p>没发现什么问题!</p> <p>你用那根等高线试试，就是我贴图上的那根与另外好几根差不多同样属性的多段线试试</p><p>我试验的时候，结果想贴图的那样，应该有6个交点的，但实际只画了5个圆，只返回5个交点</p> 本帖最后由 作者 于 2008-3-18 23:31:30 编辑 <br /><br /> <p><u><strong>以下红色为错误,已更改，再试试，呵呵，粗心了点</strong></u></p><p>Option Explicit</p><p>Private Sub CommandButton1_Click()</p><p><br/>On Error Resume Next<br/>UserForm1.Hide</p><p>'选择等高线<br/>Dim EntObj(0 To 0) As AcadEntity<br/>Dim PPt As Variant</p><p>ThisDrawing.Utility.GetEntity EntObj(0), PPt, "选择等高线: "<br/>If EntObj(0) Is Nothing Then Exit Sub</p><p>'求直线的外框<br/>Dim Pt1 As Variant<br/>Dim Pt2 As Variant<br/>EntObj(0).GetBoundingBox Pt1, Pt2</p><p>'创建选择集<br/>Dim ssetObj As AcadSelectionSet<br/>Set ssetObj = ThisDrawing.SelectionSets("SSET")<br/>If Err Then Set ssetObj = ThisDrawing.SelectionSets.Add("SSET")<br/>ssetObj.Clear</p><p>'只选取图层为DGX的图层<br/>'选择与该直线相交或者包含在外框中的所有实体<br/>Dim fType(0) As Integer<br/>Dim fData(0) As Variant</p><p>fType(0) = 8: fData(0) = "dgx"<br/>ssetObj.Select acSelectionSetCrossing, Pt1, Pt2, fType, fData</p><p><br/>'由于其中包含了自身实体，故应从选择集中移走<br/>'由于移去函数的参数是对象集合，所以在上面定义的是单个对象的对象集合<br/>ssetObj.RemoveItems EntObj</p><p><br/>Dim entTempElev As Double</p><p> entTempElev = EntObj(0).Elevation<br/>EntObj(0).Elevation = 0</p><p></p><p>'将等高线高程暂时化为0，原高程存储到数组elevTemp（）中<br/>Dim I As Integer</p><p>Dim elevTemp() As Double<br/><font color="#ff0000">ReDim elevTemp(0 To ssetObj.Count - 1)'这里错误，范围应为0~count-1</font></p><p><br/><font color="#ff0000">For I = 0 To ssetObj.Count - 1'这里错误，范围应为0~count-1</font><br/> elevTemp(I) = ssetObj.Item(I).Elevation<br/> ssetObj.Item(I).Elevation = 0<br/> ssetObj.Item(I).Update<br/>Next</p><p></p><p>'枚举交点，判断是否相交<br/>Dim pts As Variant<br/>Dim circle1() As AcadCircle<br/>ReDim circle1(ssetObj.Count - 1)<br/>Dim a As Integer</p><p>For I = 0 To ssetObj.Count - 1<br/> pts = ssetObj(I).IntersectWith(EntObj(0), acExtendNone)<br/> If Not IsEmpty(pts) Then<br/> Dim circleT(2) As Double<br/> circleT(0) = pts(0): circleT(1) = pts(1): circleT(2) = 0<br/> <br/> circle1(I) = ThisDrawing.ModelSpace.AddCircle(circleT, 0.5)</p><p> End If<br/>Next</p><p>EntObj(0).Elevation = entTempElev<br/><font color="#ff0000">For I = 0 To ssetObj.Count - 1)'这里错误，范围应为0~count-1<br/></font> ssetObj.Item(I).Elevation = elevTemp(I)<br/> ssetObj.Item(I).Update<br/>Next</p><p>UserForm1.Show<br/>End Sub</p> 学习了 谢谢！ <p>真的可以了，太谢谢了，困扰了一天</p>
页:
[1]