liuyang4740 发表于 2008-6-16 20:15:00

求助：选择集内直线问题

选择集内有2条相交直线，现在通过"break"命令实现了在交点处打断，打断之后，选择集就只有2条线 但是怎样让选择集重新包含打断了的4条直线呢？

xinglee 发表于 2008-6-18 09:28:00

利用selectpoint方法。

robbin840311 发表于 2008-6-18 10:04:00

<p>ReSelSet:</p><p>&nbsp; '建立选择集</p><p>&nbsp; LineSelset.Select acSelectionSetAll, , , LineType, LineData</p><p>&nbsp;&nbsp;'打断直线</p><p>&nbsp; LineSelSet.Clear&nbsp; '清空选择集</p><p>&nbsp; goto ReSelSet&nbsp;&nbsp; '重新建立选择集&nbsp; </p><p></p><p>LZ：请问两条直线在交点处打断，通过VBA是怎么实现的？</p>

liuyang4740 发表于 2008-6-18 13:09:00

可以调用cad命令，你可以具体看看论坛上的，cad转换双元表

liuyang4740 发表于 2008-6-20 17:10:00

<p>程序如下，但是还是不能实现直线长度小于2000的自动删除，有时候可以，有时候不行，在vba界面里面按执行按钮可以，在cad里面里面点击“宏”运行就不行，为什么呢？</p><p>Sub r4()&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '相交的直线彼此打断</p><p>&nbsp;&nbsp;&nbsp; Dim returnObj As AcadEntity<br/>&nbsp;&nbsp;&nbsp; Dim y(1 To 3) As Double<br/>&nbsp;&nbsp;&nbsp; Dim ss(100000) As Variant<br/>&nbsp;&nbsp;&nbsp; Dim det As String<br/>&nbsp;&nbsp;&nbsp; Dim det1 As String<br/>&nbsp;&nbsp;&nbsp; Dim lspPnt As String<br/>&nbsp;&nbsp;&nbsp;&nbsp;<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<br/>&nbsp;&nbsp;&nbsp; On Error Resume Next<br/>&nbsp;&nbsp;&nbsp; SsetName = "au100"<br/>&nbsp;&nbsp;&nbsp; On Error Resume Next<br/>&nbsp;&nbsp;&nbsp; For i = 0 To ThisDrawing.SelectionSets.Count - 1<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set SsetObj = ThisDrawing.SelectionSets.Item(i)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If SsetObj.Name = "au100" Then SsetObj.Delete<br/>&nbsp;&nbsp;&nbsp; Next i<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set SsetObj = ThisDrawing.SelectionSets.Add(SsetName)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; SsetObj.SelectOnScreen<br/>&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; j = SsetObj.Count<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; MsgBox j<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; k = 0<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp; For i = 0 To j - 1<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; For ii = 0 To j - 1<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If Abs(SsetObj.Item(i).Angle - SsetObj.Item(ii).Angle) &gt; 0.5 Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ss(k) = SsetObj.Item(i).IntersectWith(SsetObj.Item(ii), acExtendBoth)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; det = GetDoubleEntTable(SsetObj.Item(i), ss(k))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; det1 = GetDoubleEntTable(SsetObj.Item(ii), ss(k))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; lspPnt = axPoint2lspPoint(ss(k))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ThisDrawing.SendCommand "_break" &amp; vbCr &amp; det &amp; vbCr &amp; lspPnt &amp; vbCr<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ThisDrawing.SendCommand "_break" &amp; vbCr &amp; det1 &amp; vbCr &amp; lspPnt &amp; vbCr<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; SsetObj.SelectAtPoint ss(k)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; k = k + 1<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Next<br/>&nbsp;&nbsp;&nbsp;&nbsp; Next&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<br/>&nbsp;&nbsp; For i = 0 To SsetObj.Count<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If SsetObj.Item(i).Length &lt; 2000 Then SsetObj.Item(i).Delete<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Next<br/>&nbsp;&nbsp;&nbsp;&nbsp;End Sub</p><p>'转换双元表的函数<br/>Public Function GetDoubleEntTable(entObj As AcadEntity, Pnt As Variant) As String<br/>&nbsp;&nbsp;&nbsp; Dim entHandle As String<br/>&nbsp;&nbsp;&nbsp; entHandle = entObj.Handle<br/>&nbsp;&nbsp;&nbsp; GetDoubleEntTable = "(list(handent " &amp; Chr(34) &amp; entHandle &amp; Chr(34) &amp; _<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ")(list " &amp; Str(Pnt(0)) &amp; Str(Pnt(1)) &amp; Str(Pnt(2)) &amp; "))"</p>

兰州人 发表于 2008-6-21 12:42:00

liuyang4740发表于2008-6-16 20:15:00static/image/common/back.gif选择集内有2条相交直线，现在通过\"break\"命令实现了在交点处打断，打断之后，选择集就只有2条线 但是怎样让选择集重新包含打断了的4条直线呢？

<p>在没打断前获得选择集的 minPoint,maxPoint坐标，如.GetBoundingBox可以获得实体的minPoint,maxPoint,打断后在重新定义sset选择集用minPoint,maxPoint</p>

liuyang4740 发表于 2008-7-18 16:45:00

.GetBoundingBox没法获得选择集的minPoint,maxPoint坐标，只有实体才能用.GetBoundingBox方法阿！
页: [1]
查看完整版本: 求助：选择集内直线问题