Message 1 of 3
Applying the copy and Move command to a group
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Good Day.
I have created a group that collects all the objects on my sheet. The group has a color property which works fine. However I cannot find a copy or move property to treat all of the objects as one. I have to go through the items in the group individually in order to apply these commands. This is time consuming and defeats the purpose of grouping. Here is my code that works fine.
So, is there a simple way to achieve my objective?
Public Sub AddAGroup()
Dim GroupObject As AcadGroup
Dim ObjectsForGroup() As AcadEntity
Dim CircleObject As AcadCircle
Dim Center(0 To 2) As Double
Dim Radius As Double
Dim Count As Integer
Center(0) = 1: Center(1) = 1: Center(2) = 0
Radius = 1.5
Set CircleObject = ThisDrawing.ModelSpace.AddCircle(Center, Radius)
ReDim ObjectsForGroup(0 To ThisDrawing.ModelSpace.Count - 1) As AcadEntity
For Count = 0 To ThisDrawing.ModelSpace.Count - 1
Set ObjectsForGroup(Count) = ThisDrawing.ModelSpace.Item(Count)
Next
Set GroupObject = ThisDrawing.Groups.Add("MyGroup")
GroupObject.AppendItems ObjectsForGroup
GroupObject(0).Color = acGreen
GroupObject.Highlight True
ThisDrawing.Regen acActiveViewport
End Sub
Can