zoukankan      html  css  js  c++  java
  • AutoCAD VBA对象的组合和拆散

    AutoCAD VBA对象的组合和拆散,很好用的操作,代码如下。

    Sub AddUnNameGroup()
    Dim SelObjects As AcadSelectionSet
    Dim appendObjs() As AcadEntity
    Set SelObjects = GetSelSet
    Dim UnNameGroup As AcadGroup
    Set UnNameGroup = ThisDrawing.Groups.Add("*")
    ReDim appendObjs(0 To SelObjects.Count - 1)
    Dim i As Integer
    For i = 0 To SelObjects.Count - 1
    Set appendObjs(i) = SelObjects.Item(i)
    Next
    UnNameGroup.AppendItems appendObjs
    End Sub
    Public 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 Then Set ss = ThisDrawing.SelectionSets.Add(ssName)
    ss.Clear
    ss.SelectOnScreen
    End If
    Set GetSelSet = ss
    End Function
    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(i).Delete
    Exit For
    End If
    Next
    Next
    Next
    End Sub

    代码完。

    作者:codee
    文章千古事,得失寸心知。


  • 相关阅读:
    Objective-c 语法,类/属性/函数(iOS学习笔记,从零开始。)
    设置UIButton 对齐方式
    iOS Runtime[转载]
    使用带粒子效果的 CAEmitterLayer
    使用maskView设计动画效果
    url、href、src 详解
    良好的JavaScript编码风格(语法规则)
    关于闭包
    盒子模型详解
    git入门笔记汇总——(廖雪峰博客git入门)
  • 原文地址:https://www.cnblogs.com/bimgoo/p/2502929.html
Copyright © 2011-2022 走看看