[求助]关于选择集，当图纸缩小或者扩大超出可视范围时的影响
<p>请教一个问题，我写了一个程序，是为了判断我的图纸里面有没有2个以上的块叠在一起，或者说如果是2个块叠加在一起就一定要一个是“上穿孔”，一个是“下穿孔”，要不是的话就标志出来。如果我把这个图纸放大到全部显示的情况下程序没有问题，可如果当我把图纸缩小的非常下的时候（可以吧图纸缩小到一个点那么大），就会发现所有的块都被标志了，我查看了程序，竟然发现所有的块都被我用ssetObj2.Select mode, corner1, corner2, filterType, filterData所构成的块选择中了。当然如果扩大超出可视范围则有问题的块也不能被发现了（这个我还能解释）。问下大家这个问题该怎么解决，如果仅仅从选择集没有办法解决的华，还有其他思路吗。图纸和代码都在压缩包里面。</p> <p>我看了论坛上这个帖子，也是相同的问题</p><p><a href="http://www.mjtd.com/BBS/dispbbs.asp?BoardID=4&replyID=29150&id=36383&skin=0">http://www.mjtd.com/BBS/dispbbs.asp?BoardID=4&replyID=29150&id=36383&skin=0</a></p><p>特别是这段话，我觉得和我体会以一样：（hangc兄 ， 在实践中 发现选择集确实和范围有关。<br/><br/><br/>我现在使用acSelectionSetWindow之前都要先 zoom一下。）</p> 或许有的人要问，你干嘛把图纸缩小的那么小啊，放大点不久可以了，可事实是我要处理的图纸太大了，不是一般的大，所以实际上的节点就是非常小的。恳请大家帮我提供一条思路，怎么解决这个问题。 <p>在循环中用选择集应是不好的，楼主可以考虑用插入点的距离进行判断不？</p><p>不过这样速度比较慢啊</p><p></p><p>Private Sub CommandButton1_Click()<br/> Dim retCoord As Variant<br/> Dim elem As AcadEntity<br/> Dim corner1(0 To 2) As Double<br/> Dim corner2(0 To 2) As Double<br/> Dim dd, rr As Double<br/> rr = 23.5651 * 2<br/> Dim ptMin, ptMax<br/> Dim objRec As AcadLWPolyline<br/> '关于扩展数据的变量<br/> Dim dataType(0 To 1) As Integer<br/> Dim data(0 To 1) As Variant<br/> dataType(0) = 1001: data(0) = "MY_NodeSign"<br/> dataType(1) = 1000: data(1) = "blkMark"</p><p> '创建选择集，用于选择设备<br/> Dim ssetObj1 As AcadSelectionSet<br/> Dim filterType(0 To 6) As Integer<br/> Dim filterData(0 To 6) As Variant<br/> '安全的建立选择集<br/> Set ssetObj1 = CreateSelectionSet("SSET1")</p><p> Dim mode As Integer<br/> '创建两个选择集，用于选择设备<br/> Dim ssetObj2 As AcadSelectionSet<br/> '选择模式为通过某个区域<br/> mode = acSelectionSetCrossing<br/> '安全的建立选择集<br/> <br/> <br/> '防止出现ESC错误<br/> 'On Error Resume Next</p><p> filterType(0) = 0<br/> filterData(0) = "Insert"<br/> filterType(1) = 100<br/> filterData(1) = "AcDbBlockReference"<br/> filterType(2) = -4<br/> filterData(2) = "<or"<br/> filterType(3) = 2<br/> filterData(3) = "上穿孔"<br/> filterType(4) = 2<br/> filterData(4) = "下穿孔"<br/> filterType(5) = 2<br/> filterData(5) = "节点"<br/> filterType(6) = -4<br/> filterData(6) = "or>"<br/> ssetObj1.Select acSelectionSetAll, , , filterType, filterData<br/> MsgBox ssetObj1.Count</p><p> '创建图块列表、扫描模型空间集合<br/> For Each elem In ssetObj1<br/> retCoord = elem.InsertionPoint<br/> '建立一个以首尾某个点为中心的长和宽为20MM的矩形<br/> corner1(0) = retCoord(0)<br/> corner1(1) = retCoord(1)<br/> corner1(2) = 0<br/> <br/> For Each elem2 In ssetObj1<br/> If elem.Handle = elem2.Handle Then GoTo nextelem2<br/> <br/> retCoord = elem2.InsertionPoint<br/> corner2(0) = retCoord(0)<br/> corner2(1) = retCoord(1)<br/> corner2(2) = 0<br/> <br/> dd = ((corner1(0) - corner2(0)) ^ 2 + (corner1(1) - corner2(1)) ^ 2) ^ 0.5</p><p> If dd - rr < 0.001 Then<br/> If (elem.Name = "上穿孔" And elem2.Name = "下穿孔") Or _<br/> (elem2.Name = "上穿孔" And elem.Name = "下穿孔") Then<br/> <br/> Else '当有2个块叠在一起，别且不是 "上穿孔"和 "下穿孔"对应的情况下，则标志之<br/> elem.GetBoundingBox ptMin, ptMax<br/> Set objRec = AddSignRectangle(ptMin, ptMax, 1)<br/> objRec.color = acRed '151<br/> objRec.SetXData dataType, data<br/> objRec.Update<br/> End If<br/> End If<br/>nextelem2:<br/> Next elem2<br/> Next elem<br/> <br/> <br/> ssetObj1.Delete<br/>End Sub<br/></p> 呵呵，阁下这个思路确实不错，真是谢谢了，我觉得你这个思路的速度应该也还可以，我今天采用了ZoomWindow point1，point2 这个命令解决了这个问题，感觉速度还可以。
页:
[1]