steven8386 发表于 2008-5-3 11:36:00

录找CAD -GROUP 超级命令

<p>用group创建组的时候，需要输入实名设置，但是我想一少到位的，像CAD LT版本中的group一样，现在编组我刚弄好了，但是解组还是不行！</p><p>编组：-group ; ;* ;*\</p><p>但是解组就弄不出来了，请各位帮忙看看，要不然的话，帮我写个加载应用程序也可以的！</p><p>我用的是CAD2009版本的！</p><p><br/>谢谢！</p><p></p>

geraldxyz 发表于 2008-5-26 15:03:00

<p>在晓东里找到一个这样的帖子，似乎和你的要求沾点边：<a href="http://www.xdcad.net/forum/showthread.php?s=&amp;postid=894063#post894063">http://www.xdcad.net/forum/showthread.php?s=&amp;postid=894063#post894063</a></p><p></p><p>但是不知道怎么加载：附代码如下：</p><p><table height="100%"><tbody><tr><td colspan="2"><font id="text7" face="宋体,verdana, arial, helvetica" style="FONT-SIZE: 10pt;"><blockquote>回复: <table cellspacing="0" cellpadding="0" width="80%" bgcolor="#ffffff"><tbody><tr><td><table cellspacing="1" cellpadding="2" width="100%" border="0"><tbody><tr><td bgcolor="#f3f3f3">最初由 chenhang 发布<br/><b>请问怎么把组分解开<br/>因为我图中的组都没有命名，而且有很多组，如果把要分解的组在GROUP的菜单中找出来再分解很麻烦。有什么命令可以直接分解组。就象炸开块一样？<img alt="" src="http://www.xdcad.net/forum/images/smilies/em19.gif" border="0"/>
                                                                                                                                </b></td></tr></tbody></table></td></tr></tbody></table></blockquote><br/>这是别人写的，借花献佛<br/></font><div style="MARGIN: 5px 20px 20px;"><div class="smallfont" style="MARGIN-BOTTOM: 2px;"><font face="宋体,verdana,arial,helvetica">代码:<pre class="alt2" style="BORDER-RIGHT: 1px inset; PADDING-RIGHT: 6px; BORDER-TOP: 1px inset; PADDING-LEFT: 6px; PADDING-BOTTOM: 6px; MARGIN: 0px; OVERFLOW: auto; BORDER-LEFT: 1px inset; WIDTH: 99%; PADDING-TOP: 6px; BORDER-BOTTOM: 1px inset;"><font face="宋体,verdana, Airal,Helvetica,Geneva" style="FONT-SIZE: 10pt;">
<font face="courier new">
'将选定的组合分解开
'由于不能通过选定的对象来直接找到其组合名称，只能通过循环比较对象ID的方法
'来解决这个问题，运行时可能会慢点，但对象不多的情况下应该没问题
Sub DelUnNameGroup()

    Dim SelGroup As AcadGroup
    Dim SelObjects As AcadSelectionSet
    Set SelObjects = GetSelSet
    Dim ObjInSelSet As AcadObject
    Dim I As Integer
    Dim J As Integer
    Dim K As Integer
    Dim ObjInGroup As AcadObject
    On Error Resume Next
    For I = 0 To SelObjects.Count - 1
      Set ObjInSelSet = SelObjects.Item(I)
      For J = 0 To ThisDrawing.Groups.Count - 1
            For K = 0 To ThisDrawing.Groups.Item(J).Count - 1
                Set ObjInGroup = ThisDrawing.Groups.Item(J).Item(K)
                If ObjInGroup.ObjectID = ObjInSelSet.ObjectID Then
                  ThisDrawing.Groups.Item(J).Delete
                  Exit For
                End If
            Next
      Next
    Next
End Sub

'对象选择函数
Function GetSelSet() As AcadSelectionSet
    Dim ss As AcadSelectionSet
    Set ss = ThisDrawing.PickfirstSelectionSet
    If ss.Count = 0 Then
      Dim ssName As String
      ssName = "strSSet"
      On Error Resume Next
      Set ss = ThisDrawing.SelectionSets(ssName)
      If Err &lt;&gt; 0 Then
         Err.Clear
         Set ss = ThisDrawing.SelectionSets.Add(ssName)
      End If
      ss.Clear
      ss.SelectOnScreen
    End If
    Set GetSelSet = ss
End Function

</font>
</font></pre></font></div><pre class="alt2" style="BORDER-RIGHT: 1px inset; PADDING-RIGHT: 6px; BORDER-TOP: 1px inset; PADDING-LEFT: 6px; PADDING-BOTTOM: 6px; MARGIN: 0px; OVERFLOW: auto; BORDER-LEFT: 1px inset; WIDTH: 99%; PADDING-TOP: 6px; BORDER-BOTTOM: 1px inset;"><font face="宋体,verdana, Airal,Helvetica,Geneva" style="FONT-SIZE: 10pt;">
<font face="courier new">
'将选定的组合分解开
'由于不能通过选定的对象来直接找到其组合名称，只能通过循环比较对象ID的方法
'来解决这个问题，运行时可能会慢点，但对象不多的情况下应该没问题
Sub DelUnNameGroup()

    Dim SelGroup As AcadGroup
    Dim SelObjects As AcadSelectionSet
    Set SelObjects = GetSelSet
    Dim ObjInSelSet As AcadObject
    Dim I As Integer
    Dim J As Integer
    Dim K As Integer
    Dim ObjInGroup As AcadObject
    On Error Resume Next
    For I = 0 To SelObjects.Count - 1
      Set ObjInSelSet = SelObjects.Item(I)
      For J = 0 To ThisDrawing.Groups.Count - 1
            For K = 0 To ThisDrawing.Groups.Item(J).Count - 1
                Set ObjInGroup = ThisDrawing.Groups.Item(J).Item(K)
                If ObjInGroup.ObjectID = ObjInSelSet.ObjectID Then
                  ThisDrawing.Groups.Item(J).Delete
                  Exit For
                End If
            Next
      Next
    Next
End Sub

'对象选择函数
Function GetSelSet() As AcadSelectionSet
    Dim ss As AcadSelectionSet
    Set ss = ThisDrawing.PickfirstSelectionSet
    If ss.Count = 0 Then
      Dim ssName As String
      ssName = "strSSet"
      On Error Resume Next
      Set ss = ThisDrawing.SelectionSets(ssName)
      If Err &lt;&gt; 0 Then
         Err.Clear
         Set ss = ThisDrawing.SelectionSets.Add(ssName)
      End If
      ss.Clear
      ss.SelectOnScreen
    End If
    Set GetSelSet = ss
End Function

</font>
</font></pre></div><div></div><font></font></td></tr><tr><td valign="bottom" colspan="2">如果楼主知道怎么用了还望告知一声啊：）<br/><br/><br/><table width="100%" valign="bottom"><tbody><tr><td align="left"><noamlfont></noamlfont><font></font></td></tr><tr><td align="right"><font face="宋体,verdana,arial,helvetica"><a href="http://p4.xdcad.net/forum/report.php?s=&amp;postid=891993"><font color="#003300">向版主反映该贴</font></a> | IP: <a href="http://www.xdcad.net/forum/postings.php?s=&amp;action=getip&amp;postid=891993"><font color="#003300">已记录</font></a></font></td></tr></tbody></table></td></tr></tbody></table><br/></p>

claotlaot 发表于 2008-6-29 18:21:00

不明白怎么使用
页: [1]
查看完整版本: 录找CAD -GROUP 超级命令