求助！怎样将某个图层的所有图形放到一个选择集中？
本帖最后由 作者 于 2005-10-18 10:02:50 编辑 <br /><br /> <P>求助！怎样将某个图层的所有图形放到一个选择集中？lisp vba都要，万分感谢！</P><P>要实现这样的功能：将某图层的所有图形历篇，将每一类完全一样的图形COPY到工作区的另一个地方，之后还要对COPY出来的图形进行编辑，可以吗？万分感谢！！</P> <P>Function GetSel(Optional Name = "TLSSEL") As AcadSelectionSet<BR>On Error Resume Next<BR> ThisDrawing.SelectionSets(Name).Delete<BR> Set GetSel = ThisDrawing.SelectionSets.Add(Name)<BR>End Function</P>
<P>Sub t()<BR>Dim ss As AcadSelectionSet<BR>Set ss = GetSel()</P>
<P>Dim ft(0) As Integer, fd(0)<BR>LayerName = "0"<BR>ft(0) = 8: fd(0) = LayerName</P>
<P>ss.Select acSelectionSetAll, , , ft, fd</P>
<P>End Sub</P>
<P> </P> <P>谢谢版主!我回家试一下！</P> <P>Function GetSel(Optional Name = "TLSSEL") As AcadSelectionSet<BR>On Error Resume Next<BR> ThisDrawing.SelectionSets(Name).Delete<BR> Set GetSel = ThisDrawing.SelectionSets.Add(Name)<BR>End Function<BR>Sub jh()<BR>Dim p1(0 To 2) As Double<BR>Dim ss As AcadSelectionSet<BR>Set ss = GetSel()<BR>'ss.SelectOnScreen<BR>'For j = 0 To ss.Count - 1<BR> ' ms = ss.Item(j).ObjectID & Chr(10) + ms<BR>'Next<BR>'MsgBox ms</P>
<P>Dim ft(0) As Integer, fd(0)<BR>LayerName = "c1"<BR>ft(0) = 8: fd(0) = LayerName<BR>ss.Select acSelectionSetAll, , , ft, fd<BR> For i = 0 To ss.Count - 1<BR> If i > ss.Count - 1 Then GoTo pp:<BR> gs = 0<BR> MsgBox ss.Item(i).ObjectName & Chr(10) & ss.Item(i).ObjectID & Chr(10) & i<BR> ss.Item(i).GetBoundingBox mind, maxd<BR> a = maxd(0) - mind(0)<BR> b = maxd(1) - mind(1)<BR> For k = 1 To ss.Count - 1<BR> If k > ss.Count - 1 Then GoTo kk:<BR> ss.Item(k).GetBoundingBox mindt, maxdt<BR> at = maxdt(0) - mindt(0)<BR> bt = maxdt(1) - mindt(1)<BR> If at = a And bt = b And ss.Item(k).ObjectID <> ss.Item(i).ObjectID Then<BR> 'MsgBox ss.Item(k).ObjectID & Chr(10) & k<BR> ss.Item(k).Delete<BR> gs = gs + 1<BR> Set ss = GetSel()<BR> LayerName = "c1"<BR> ft(0) = 8: fd(0) = LayerName<BR> ss.Select acSelectionSetAll, , , ft, fd<BR> k = k - 1<BR> End If<BR> Next<BR>kk: Dim sm As AcadMText<BR> pb = ThisDrawing.Utility.GetPoint(, "选择基点:" & Chr(10))<BR> ss.Item(i).Move mind, pb<BR> ss.Item(i).GetBoundingBox minda, maxda<BR> p1(0) = minda(O): p1(1) = minda(1) - 5: p1(2) = minda(2)<BR> w = a / 5<BR> Set sm = ThisDrawing.ModelSpace.AddMText(p1, w, gs + 1)<BR> sm.Layer = "t1"<BR>Next<BR>pp:</P>
<P>End Sub</P>
<P>不行呀！救救呀！</P> 请问怎样选择整个图层内的所有对象呢？ <P>还有版主的代码有点看不懂：</P>
<P> ThisDrawing.SelectionSets(Name).Delete<BR> Set GetSel = ThisDrawing.SelectionSets.Add(Name)<BR>为什么要删除后添加呢</P> <P>你在For循环里为什么要改变ss的值？</P>
<P>你要达到什么效果？</P>
页:
[1]