黄玉宏 发表于 2009-1-30 15:48:00

[求助]求仅选择块内文字的选择集代码

<p>首先祝大家新年快乐.万事如意.心想事成!</p><p>求：１.仅选择模型空间中所有块内文字的选择集代码；２.选择模型空间中除块内文字之外的所有文字的选择集代码。</p><p>谢谢</p><p>黄玉宏&nbsp;&nbsp; 1.30</p>

黄玉宏 发表于 2009-2-12 16:41:00

<p>&nbsp; 再次请教各位,请帮忙.</p><p>&nbsp; 谢谢!</p>

nhy12345678 发表于 2009-2-12 23:39:00

本帖最后由 作者 于 2009-2-12 23:39:17 编辑 <br /><br /> <p>第一个问题：答案,TextSS自定义函数来完成，返回仅选择模型空间中所有块内文字的选择集，并从所有块中拷贝出来文字对象</p><p>&nbsp;&nbsp;&nbsp; test为测试子程序，显示所有块内的文字对象个数，检验是正确的</p><p>Sub test()<br/>Dim sss As AcadSelectionSet<br/>delSS<br/>Set sss = ThisDrawing.SelectionSets.Add("sss")<br/>Set sss = TextSS<br/>MsgBox sss.count<br/>End Sub</p><p>Public Function TextSS() As AcadSelectionSet<br/>Dim ss As AcadSelectionSet<br/>Dim aa(0 To 0) As AcadEntity<br/>Dim ppp As AcadEntity<br/>Dim NewEnt As AcadEntity<br/>Dim expp As Variant<br/>Dim i As Long<br/>Dim ii As Long</p><p>Set ss = ThisDrawing.SelectionSets.Add("ss")<br/>&nbsp;&nbsp; For i = 0 To ThisDrawing.ModelSpace.count - 1 '遍历模型空间所有对象<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set NewEnt = ThisDrawing.ModelSpace.Item(i)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If NewEnt.ObjectName = "AcDbBlockReference" Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; expp = NewEnt.Explode<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; For ii = 0 To UBound(expp)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set ppp = expp(ii)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If ppp.ObjectName = "AcDbText" Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set aa(0) = ppp<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ss.AddItems aa<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Else<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ppp.Delete<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Next ii<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp; Next i<br/>Set TextSS = ss<br/>End Function</p><p>Public Function delSS()<br/>Do While ThisDrawing.SelectionSets.count &gt; 0 '=====安全创建选择集<br/>&nbsp;&nbsp; ThisDrawing.SelectionSets.Item(0).Delete<br/>Loop<br/>End Function</p><p>第2给问题就更简单了：答案,TextSS2自定义函数来完成，选择模型空间中除块内文字之外的所有文字的选择集，</p><p>&nbsp;&nbsp;&nbsp;&nbsp; test2为测试子程序，显示所有除块内文字之外的文字对象个数，检验是正确的</p><p>Sub test2()<br/>Dim sss As AcadSelectionSet<br/>delSS<br/>Set sss = ThisDrawing.SelectionSets.Add("sss")<br/>Set sss = TextSS2<br/>MsgBox sss.count<br/>End Sub</p><p>Public Function TextSS2() As AcadSelectionSet<br/>Dim ss As AcadSelectionSet<br/>Dim aa(0 To 0) As AcadEntity<br/>Dim NewEnt As AcadEntity<br/>Dim i As Long<br/>Set ss = ThisDrawing.SelectionSets.Add("ss")<br/>&nbsp;&nbsp; For i = 0 To ThisDrawing.ModelSpace.count - 1 '遍历模型空间所有对象<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set NewEnt = ThisDrawing.ModelSpace.Item(i)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If NewEnt.ObjectName = "AcDbText" Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set aa(0) = NewEnt<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ss.AddItems aa<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp; Next i<br/>Set TextSS2 = ss<br/>End Function</p><p>Public Function delSS()<br/>Do While ThisDrawing.SelectionSets.count &gt; 0 '=====安全创建选择集<br/>&nbsp;&nbsp; ThisDrawing.SelectionSets.Item(0).Delete<br/>Loop<br/>End Function</p>
页: [1]
查看完整版本: [求助]求仅选择块内文字的选择集代码