Solved: Groups Autocad VBA

[rvetrano]

Hi
What I would like to do is place 2 or more items in my drawing and group them. when I use this code it groups everything. Haven't been able to figure out how to create a selection set of the objects that are placed in the drawing and then get them into the group.

Thanks
Bob v



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

[Tommy]

Just so I understand, the drawing may/may not contain other objects. The ones you want are just the ones you created right?

Tommy

[Tommy]

What I have done here is grab the last # of entities created. Autocad adds the entities from the first created to the last created. Since in you example you created 2 entities to group them you would need to grab the last 2 in the ThisDrawing.ModelSpace.count.

Another thing you may want to consider is to check for the layer before creating the object and if the layer is not there add it.

[VBA]
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
Dim cntr As Integer
Dim ObjCntr As Integer '<- object counter
cntr = 0
ObjCntr = 0
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"
ObjCntr = ObjCntr + 1 '<- for each object created add to the counter
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"
ObjCntr = ObjCntr + 1 '<- for each object created add to the counter
'ReDim ObjForGroup(0 To ThisDrawing.ModelSpace.count - 1) As AcadEntity
ReDim ObjForGroup(0 To ObjCntr - 1) As AcadEntity '<-- changed to the # of entities created
'For count = 0 To ThisDrawing.ModelSpace.count - 1
For count = ThisDrawing.ModelSpace.count - 1 To ThisDrawing.ModelSpace.count - ObjCntr Step -1 '<- changed to the last # of entities
Set ObjForGroup(cntr) = ThisDrawing.ModelSpace.Item(count)
cntr = cntr + 1
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

[/VBA]

[rvetrano]

Tommy
Thanks that is what I am trying to do.

bob v

[Tommy]

Good Deal! Glad I could help!