apollotime 发表于 2006-10-27 15:15:00

取图元颜色和线型有大问题？？？？？

AcadSelectionSet　取图元颜色和线型 <IFRAME marginWidth=0 marginHeight=0 src="/mcfile/google180.htm" frameBorder=0 width=180 scrolling=no height=150></IFRAME>
<P>AcadSelectionSet　取图元颜色和线型，在不同图层内，只以取到２５６这个值</P>
<P>代码如下：</P>
<P>Sub main()<BR>&nbsp; Dim sets As AcadSelectionSet<BR>&nbsp; Dim i As Integer<BR>&nbsp; Set sets = ThisDrawing.SelectionSets.Add("Select")<BR>&nbsp; sets.SelectOnScreen<BR>&nbsp; For i = 0 To sets.Count - 1<BR>&nbsp;&nbsp;&nbsp; MsgBox "当前颜色值为：" &amp; sets.Item(i).color<BR>&nbsp; Next i<BR>&nbsp; sets.Delete<BR>End Sub<BR></P>
<P>谢谢！！！</P>

apollotime 发表于 2006-10-27 15:47:00

<P>Sub main()<BR>&nbsp; Dim sets As AcadSelectionSet<BR>&nbsp; Dim i As Integer<BR>&nbsp; Set sets = ThisDrawing.SelectionSets.Add("Select")<BR>&nbsp; sets.SelectOnScreen<BR>&nbsp; For i = 0 To sets.Count - 1<BR>&nbsp;&nbsp;&nbsp;&nbsp; If sets.Item(i).color = 256 Then<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; MsgBox "当前颜色值为：" &amp; ThisDrawing.Layers.Item(sets.Item(i).Layer).TrueColor.ColorIndex<BR>&nbsp;&nbsp;&nbsp;&nbsp; Else<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; MsgBox "当前颜色值为：" &amp; sets.Item(i).color<BR>&nbsp;&nbsp;&nbsp;&nbsp; End If<BR>&nbsp;&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp; <BR>&nbsp; Next i<BR>&nbsp; sets.Delete<BR>End Sub</P>
<P>这样解决行吗</P>
页: [1]
查看完整版本: 取图元颜色和线型有大问题？？？？？