Grouping objects

Hi
What I would like to do is create aa individual group of 2 or more objects
that place in my drawing . whats happening now is it groups everything in
the drawing.

Thanks
Bob vetrano



Sub CircleGroup()
Dim GroupObj As AcadGroup
Dim ObjForGroup() As AcadEntity
Dim CircleObj As AcadCircle
Dim LineObj As AcadLine
Dim Nameobj As String
Dim Center As Variant, Radius As Double
Dim StartPt(0 To 2) As Double, EndPt(0 To 2) As Double
Dim count As Integer
Dim x As Integer

Randomize ' Initialize random-number generator.

x = Int((100 * Rnd) + 1)


Center = ThisDrawing.Utility.GetPoint(, "Get circle Center")

Radius = 1.5
Set CircleObj = ThisDrawing.ModelSpace.AddCircle(Center, Radius)
CircleObj.Layer = "circle"

StartPt(0) = Center(0): StartPt(1) = Center(1): StartPt(2) = Center(2)
EndPt(0) = Center(0) + Radius + 0.5: EndPt(1) = Center(1): EndPt(2) =
Center(2)
Set LineObj = ThisDrawing.ModelSpace.AddLine(StartPt, EndPt)
LineObj.Layer = "line"


ReDim ObjForGroup(0 To ThisDrawing.ModelSpace.count - 1) As AcadEntity
For count = 0 To ThisDrawing.ModelSpace.count - 1
Set ObjForGroup(count) = ThisDrawing.ModelSpace.Item(count)
Next
Nameobj = "groupobj" & x

Set GroupObj = ThisDrawing.Groups.Add(Nameobj)
MsgBox "... " & GroupObj.Name
GroupObj.AppendItems ObjForGroup

GroupObj.Highlight True
ThisDrawing.Regen acActiveViewport
ZoomAll
End Sub

 

Robert,

Have you tried using a filtered selection set? Might be easier but iterating might be more to your liking.

Good luck,

Bob Coward
CADS, Inc

800-366-0946

 

Here you go...
Note the changes.

Sub CircleGroup()
Dim GroupObj As AcadGroup
Dim ObjForGroup(1) As AcadEntity ' Note the change from () to (1) since
all you have are 2 objects
Dim CircleObj As AcadCircle
Dim LineObj As AcadLine
Dim Nameobj As String
Dim Center As Variant, Radius As Double
Dim StartPt(0 To 2) As Double, EndPt(0 To 2) As Double
Dim count As Integer
Dim x As Integer

Randomize ' Initialize random-number generator.

x = Int((100 * Rnd) + 1)

Center = ThisDrawing.Utility.GetPoint(, "Get circle Center")

Radius = 1.5
Set CircleObj = ThisDrawing.ModelSpace.AddCircle(Center, Radius)
CircleObj.Layer = "circle"
' Added the following line
Set ObjForGroup(0) = CircleObj

StartPt(0) = Center(0): StartPt(1) = Center(1): StartPt(2) = Center(2)
EndPt(0) = Center(0) + Radius + 0.5: EndPt(1) = Center(1): EndPt(2) =
Center(2)
Set LineObj = ThisDrawing.ModelSpace.AddLine(StartPt, EndPt)
LineObj.Layer = "line"
' Added the following line
Set ObjForGroup(1) = LineObj

Nameobj = "groupobj" & x

Set GroupObj = ThisDrawing.Groups.Add(Nameobj)
MsgBox "... " & GroupObj.Name
GroupObj.AppendItems ObjForGroup

GroupObj.Highlight True
ThisDrawing.Regen acActiveViewport
ZoomAll
End Sub


--
Matt W

The difference between genius and stupidity is that genius has its limits.
| Hi
| What I would like to do is create aa individual group of 2 or more objects
| that place in my drawing . whats happening now is it groups everything in
| the drawing.
|
| Thanks
| Bob vetrano
|
|
|
| Sub CircleGroup()
| Dim GroupObj As AcadGroup
| Dim ObjForGroup() As AcadEntity
| Dim CircleObj As AcadCircle
| Dim LineObj As AcadLine
| Dim Nameobj As String
| Dim Center As Variant, Radius As Double
| Dim StartPt(0 To 2) As Double, EndPt(0 To 2) As Double
| Dim count As Integer
| Dim x As Integer
|
| Randomize ' Initialize random-number generator.
|
| x = Int((100 * Rnd) + 1)
|
|
| Center = ThisDrawing.Utility.GetPoint(, "Get circle Center")
|
| Radius = 1.5
| Set CircleObj = ThisDrawing.ModelSpace.AddCircle(Center, Radius)
| CircleObj.Layer = "circle"
|
| StartPt(0) = Center(0): StartPt(1) = Center(1): StartPt(2) = Center(2)
| EndPt(0) = Center(0) + Radius + 0.5: EndPt(1) = Center(1): EndPt(2) =
| Center(2)
| Set LineObj = ThisDrawing.ModelSpace.AddLine(StartPt, EndPt)
| LineObj.Layer = "line"
|
|
| ReDim ObjForGroup(0 To ThisDrawing.ModelSpace.count - 1) As AcadEntity
| For count = 0 To ThisDrawing.ModelSpace.count - 1
| Set ObjForGroup(count) = ThisDrawing.ModelSpace.Item(count)
| Next
| Nameobj = "groupobj" & x
|
| Set GroupObj = ThisDrawing.Groups.Add(Nameobj)
| MsgBox "... " & GroupObj.Name
| GroupObj.AppendItems ObjForGroup
|
| GroupObj.Highlight True
| ThisDrawing.Regen acActiveViewport
| ZoomAll
| End Sub
|
|
|
|

 

Matt
thanks tyhat helped alot

bob v