I need help for putting objects in different named groups

Hi All,

I am having a problem with the code below when it comes to adding objects to
a group that shows up as a grouped set in ACAD.

The code below adds "all" the items to "al"l the different subassembly
groups I find when pulling the xdata from each objects subassembly name.

I am trying to only add each item to the group subassemby (string) and no
more. I think need to some how create new se;ection set array based on each
entity in the selection set, but I am not sure how or if that is the best
way. I am not an experienced programmer and I have spend 7 hours trying to
figure this out.

If anyone could please correct the code or explain what I need to do in
simple terms so that each object in the selection set only goes to it's
subassembly string(its own group), I would be very greatfull.

Thnak you very much,

Mark


Sub Groupc(AcadApp As AcadApplication)

Dim entity As AcadDocument
Dim ssetObj As AcadSelectionSet
Dim Ent As AcadEntity
Dim objSelSet As AcadSelectionSet
Dim SubAssembly As String

Dim objEnts() As AcadEntity
Dim intIndex As Integer
Dim objGrp As AcadGroup


Set AutoCAD_Application = AcadApp
Set entity = AutoCAD_Application.ActiveDocument
On Error Resume Next
entity.SelectionSets("prev").Delete

Set objSelSet = entity.SelectionSets.Add("prev")
objSelSet.Select acSelectionSetPrevious


ReDim objEnts(objSelSet.Count - 1)

For intIndex = LBound(objEnts) To UBound(objEnts)
Set objEnts(intIndex) = objSelSet(intIndex)
Next intIndex

For Each Ent In objEnts

SubAssembly = UCase(getXdataInformation2(Ent.Handle,
"SubAssembly", entity))
Set objGrp = entity.Groups.Add(SubAssembly)

objGrp.AppendItems objEnt

Next

 

Sorry All,

The above code should have read what is below:

Sub Groupc(AcadApp As AcadApplication)
' This example finds the current Groups collection and
' adds a new group to that collection.
Dim entity As AcadDocument
Dim ssetObj As AcadSelectionSet
Dim Ent As AcadEntity
Dim objSelSet As AcadSelectionSet
Dim intIndex As Integer
Dim objGrp As AcadGroup
Dim SubAssembly As String
Dim objEnts() As AcadEntity

Set AutoCAD_Application = AcadApp
Set entity = AutoCAD_Application.ActiveDocument
On Error Resume Next
entity.SelectionSets("prev").Delete

Set objSelSet = entity.SelectionSets.Add("prev")
objSelSet.Select acSelectionSetPrevious


ReDim objEnts(objSelSet.Count - 1)

For intIndex = LBound(objEnts) To UBound(objEnts)
Set objEnts(intIndex) = objSelSet(intIndex)
Next intIndex

For Each Ent In objSelSet


SubAssembly = UCase(getXdataInformation2(Ent.Handle,
"SubAssembly", entity))
Set objGrp = entity.Groups.Add(SubAssembly)

objGrp.AppendItems objEnts

Next
End Sub

Thanks,

Mark

 

Nevermind,

I finally got it.

Here is the code:

Sub Groupc(AcadApp As AcadApplication)

Dim entity As AcadDocument
Dim ssetObj As AcadSelectionSet
Dim Ent As AcadEntity
Dim objSelSet As AcadSelectionSet
Dim intIndex As Integer
Dim objGrp As AcadGroup
Dim SubAssembly As String
Dim objEnts() As AcadEntity
Dim ent2 As AcadEntity

Set AutoCAD_Application = AcadApp
Set entity = AutoCAD_Application.ActiveDocument
On Error Resume Next
entity.SelectionSets("prev").Delete

Set objSelSet = entity.SelectionSets.Add("prev")
objSelSet.Select acSelectionSetPrevious
Dim objEnts2(0 To 0) As AcadEntity

ReDim objEnts(objSelSet.Count - 1)

For intIndex = LBound(objEnts) To UBound(objEnts)
Set objEnts(intIndex) = objSelSet(intIndex)
Next intIndex

For Each Ent In objSelSet


Set ent2 = Ent
SubAssembly = UCase(getXdataInformation2(Ent.Handle,
"SubAssembly", entity))
Set objGrp = entity.Groups.Add(SubAssembly)

Set objEnts2(0) = ent2
objGrp.AppendItems objEnts2


Next
End Sub