storyst 发表于 2008-2-26 11:01:00

如何多选不同扩展属性的实体

<p>&nbsp;Dim ssetObj As AcadSelectionSet&nbsp;<br/>&nbsp;&nbsp;&nbsp; Dim mode As Integer<br/>&nbsp;&nbsp;&nbsp; Dim gpCode(0) As Integer<br/>&nbsp;&nbsp;&nbsp; Dim dataValue(0) As Variant<br/>&nbsp;&nbsp;&nbsp; Dim groupCode As Variant<br/>&nbsp;&nbsp;&nbsp; Dim dataCode&nbsp;&nbsp; As Variant<br/>&nbsp;&nbsp;&nbsp; Dim obj As AcadLWPolyline<br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; On Error Resume Next<br/>&nbsp;&nbsp;&nbsp; If Not IsNull(ThisDrawing.SelectionSets("SSET")) Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set ssetObj = ThisDrawing.SelectionSets("SSET")<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ssetObj.Delete<br/>&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp; Set ssetObj = ThisDrawing.SelectionSets.Add("SSET")<br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; mode = acSelectionSetAll<br/>&nbsp;&nbsp;&nbsp; gpCode(0) = 1000<br/>&nbsp;&nbsp;&nbsp; groupCode = gpCode<br/>&nbsp;&nbsp;&nbsp; dataValue(0) = "600601"<br/>&nbsp;&nbsp;&nbsp; dataCode = dataValue<br/>&nbsp;&nbsp;&nbsp; ssetObj.Select mode, , , groupCode, dataCode<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If ssetObj.Count &lt;&gt; 0 Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; For Each obj In ssetObj<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; obj.color=acRed<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; obj.Update<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Next<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>我还有一个扩展属性是600602，即 dataValue(0) = "600602"。如何同时进行选择修改，使600602颜色为其他颜色？</p>

王咣生 发表于 2008-2-26 13:52:00

对扩展属性作过滤选择只能通过应用程序名过滤，而不能通过具体属性值过滤选择!

storyst 发表于 2008-2-26 14:54:00

本帖最后由 作者 于 2008-2-26 15:01:19 编辑 <br /><br /> <p>Sub b()<br/>&nbsp;&nbsp;&nbsp; Dim ssetObj As AcadSelectionSet<br/>&nbsp;&nbsp;&nbsp; Dim Pkobj As AcadEntity<br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; Dim i As Integer<br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; Dim mode As Integer<br/>&nbsp;&nbsp;&nbsp; Dim xType(0) As Integer<br/>&nbsp;&nbsp;&nbsp; Dim xData(1) As Variant<br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; Dim xTypeCode As Variant<br/>&nbsp;&nbsp;&nbsp; Dim xDataCode As Variant<br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; Dim dataValue(0) As Variant<br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; Dim obj As AcadLWPolyline<br/>&nbsp;<br/>&nbsp;&nbsp;&nbsp; Dim ObjCode As String</p><p>&nbsp;&nbsp;&nbsp; On Error Resume Next<br/>&nbsp;&nbsp;&nbsp; If Not IsNull(ThisDrawing.SelectionSets("SSET")) Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set ssetObj = ThisDrawing.SelectionSets("SSET")<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ssetObj.Delete<br/>&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp; Set ssetObj = ThisDrawing.SelectionSets.Add("SSET")<br/>&nbsp;&nbsp;&nbsp;&nbsp;<br/>&nbsp;&nbsp;<br/>&nbsp;&nbsp;&nbsp; mode = acSelectionSetAll<br/>&nbsp;&nbsp;&nbsp; xType(0) = 1000<br/>&nbsp;&nbsp;&nbsp; xData(0) = "600601"<br/>&nbsp;&nbsp;&nbsp; xData(1) = "600602"<br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; On Error Resume Next<br/>&nbsp;&nbsp;&nbsp;&nbsp; For i = 0 To 1<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; xTypeCode = xType<br/>&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; dataValue(0) = xData(i)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; xDataCode = dataValue<br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ssetObj.Select mode, , , xTypeCode, xDataCode<br/>&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; For Each Pkobj In ssetObj<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ObjCode = xData(i)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set obj = Pkobj</p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If ssetObj.Count =0 Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;exit&nbsp; sub<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; else&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Select Case ObjCode<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Case "600601"</p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; obj.ConstantWidth = 1</p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Case "600602"</p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; obj.ConstantWidth = 0.5</p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End Select<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; obj.Update<br/>&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Next<br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Next<br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp; MsgBox "结束!", vbInformation, "提示"<br/>&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp; End If<br/>&nbsp; <br/>End Sub<br/></p><p>版主，上面的程序我进行了修改，可是最终运行后的结果是两种实体的ConstantWidth都是0.5，在执行了第一个循环后继续执行第二个循环，然后就会将第一个的运算值变成由第二个值来赋予。如何在执行第一个case循环后再执行第二个case的时候不执行第一个case啊？即第一个的600601的扩展属性的实体的ConstantWidth不会再变化呢？</p>

王咣生 发表于 2008-2-26 15:31:00

<p>你这样作选择集是不能得到预期的结果的:</p><p>ssetObj.Select mode, , , xTypeCode, xDataCode</p><p>对于扩展属性只能通过应用程序名作选择集!!</p>

storyst 发表于 2008-2-26 17:14:00

<p>对于扩展属性只能通过应用程序名作选择集这句话我不理解。不过，我已经弄好啦，还是谢谢版主。</p>

雪山飞狐_lzh 发表于 2008-2-26 21:13:00

<p>除<font color="#cc5233">优化多段线</font>外，扩展属性只能用1001码过滤</p>
页: [1]
查看完整版本: 如何多选不同扩展属性的实体