Topic: Groups in vba

[MickD]

Does anyone have any examples of using groups in vba? This is a bit of a mystery, I can create and add items no problem but to select them on screen is another matter, I'd imagine you would have the same issues with other collections also.
The help doc's are very thin on this, any tidbits at all will help. In the meantime I'll keep searching for other collection examples.
Thanks,
Mick.

[MP]

Don't have vb group code, would lisp code from an old guy be of any (translation) use?

[MickD]

Don't have vb group code, would lisp code from an old guy be of any (translation) use?

Thanks Michael but I can barely grasp the basics of lisp although now I wish I had stuck at it when I tried years ago, perhaps I should be heading that way??

I have some C# code that does what I need that I can either update or convert but I'm not sure that the methods I need are exposed to vba though. If I need to go that way I'll write it in arx.

I'm having a bit of a dilemma in that I want to avoid .net so I can use the code in icad as well. The goal would be to port it to arx/drx in C eventually once I get the 'tools' side of things worked out, this way I can 'invoke' it from nearly any language to be used for scripting/automation.
This is the reason I'm using vba, it's easy to write, fast, easy to debug and fix on the fly, lisp is probably just as good if you know it and I'm not sure I have the patience/time to learn it all though it's probably better suited to the task. 

[Bryco]

I gave up on them Mick, as I prefer blocks anyway.
If they were an entity it would be easier.
I think making a Group class would make them fairly easy to use in vba,once you have the collection of its entities you can move them, select them etc

[Kerry]

Mick, Have a play
this is the only way I know of ...


Sub GrpNameTest()
   Dim acadUtility As Object
   Set acadUtility = ThisDrawing.Utility
   
    ' Select an entity
   Dim returnObj As Object
   Dim basePnt As Variant    
   ThisDrawing.Utility.GetEntity returnObj, basePnt, "Select an object: "
   
   ' Get the groups
   Dim acadGroups As Object
   Dim group As Object
   Dim groupEntity As Object
   Dim isInGroup As Boolean
   Dim length As Integer
   Dim i As Integer
   
   Set acadGroups = ThisDrawing.Groups
   isInGroup = False
   
   ' Iterate all available groups
   For Each group In acadGroups   
      length = group.Count 
          ' Get every entity from a group 
       For i = 0 To length - 1     
          Set groupEntity = group.Item(i)     
          If groupEntity.Handle = returnObj.Handle Then   
             MsgBox "Entity is from Group " + group.Name   
             isInGroup = True     
          End If 
       Next i
    Next
    If  isInGroup = False Then   
       MsgBox "Entity is in not in a group."
    End If
 End Sub

[MickD]

Thanks Kerry, looks good and pretty much what I was afraid of - looping through the whole collection. After thinking about it, from memory I had to do this in C# too (I'm pretty sure I used Alex's code snippet for that one).
I guess a short cut would be to store the group's name on the entity and retreive it by name from the collection, this will do for now though.

I'll give it a spin tomorrow and see how it goes and I'll post some group routines when done, thanks again.

[It's Alive!]

Hey Mick, Sorry to highjack your thread... I got pretty far in making .NET wrappers for SDS. Far enough to do this.

Code: [Select]

   //intellicad COM
    [CommandMethod("Test")]
    public static void Test1()
    {
      try
      {
        IntelliCAD.Application application =
          (IntelliCAD.Application)Marshal.GetActiveObject("Icad.Application");
        IntelliCAD.Document document = application.ActiveDocument;
        IntelliCAD.ModelSpace modelspace = document.ModelSpace;
        IntelliCAD.Library library = application.Library;
        IntelliCAD.Point point1 = library.CreatePoint(0,0,0);
        IntelliCAD.Point point2 = library.CreatePoint(100,100,0);
        IntelliCAD.Line line = modelspace.AddLine(point1, point2);
        line.Update();
        Marshal.ReleaseComObject(application);
      }
      catch (SystemException e)
      {
        DWM.Cad.RuntimeServices.Utilities.WriteMessage(e.Message);
      }
    }

    //through the lisp engine
    [CommandMethod("TestLine1")]
    public static void Testline1()
    {
      using (Line myLine = new Line())
      {
        myLine.Layer = "0";
        myLine.StartPoint = new Point3D(0, 0, 0);
        myLine.EndPoint = new Point3D(100, 100, 0);
        myLine.Update();
      }
    }



While this built for SDS, We/I may be able to put something together for Bricscad/Drx.
I was holding off until the ITC release it’s version of the SDK, but it’s killing me to see someone with your C/C++ talents having to use VBA. 
Anyway, it might be possible to access DRX,SDS and COM all from C#..

[Cathy]

Code: [Select]

'...snip
    'Group everything together for the move
    Set objGroup = ThisDrawing.Groups.Add("textbox")
    objGroup.AppendItems objEnts
    ThisDrawing.SendCommand ("-group rename textbox textbox" & vbCr)
    ThisDrawing.SendCommand "move g textbox " & Str(dBoxVert(0)) & "," & LTrim(Str(dBoxVert(1)) & vbCr)

I found this.  I think the rename was some kind of hack to get the group recognized in Acad. 

[MickD]

Thanks Cathy, something else to look at, you're right, the rename thing is a bit 'odd'.

Hey Mick, Sorry to highjack your thread... I got pretty far in making .NET wrappers for SDS. Far enough to do this.
....
While this built for SDS, We/I may be able to put something together for Bricscad/Drx.
I was holding off until the ITC release it’s version of the SDK, but it’s killing me to see someone with your C/C++ talents having to use VBA. 
Anyway, it might be possible to access DRX,SDS and COM all from C#..

It's kinda hard to explain, essentially I want to be COM, .net et al independent, I also want to build my own geometry routines and methods for modifying objects, mainly 3d solids independent of any particular platform.
This is possible, once I have what I need worked out I'll code it in C and I'll only need thin wrappers to use the lib in nearly any language that can call a C method from a dll.
Bricscad are working very hard at developing a true native linux version and I don't think COM and .net will be a priority for quite a while so I want to remain 'neutral' if you like.

The hard part is working out what I need, I've been down this road too many times in C/C++/C# and I have found I have wasted quite a lot of time in development of what I need only to find it won't suit the end goal and it gets re-written or tossed. This is where vba comes in (oh how I wish acad had Python ), I can throw something together, run and debug it on the fly and then attack another problem. If I have to throw something out it hasn't cost me near as much time which I don't have a lot of anyway, it's all proof of concept at this stage.

[MickD]

Here's what I come up with, it's a modified version of the code Kerry posted, it just loops through the groups and if it finds it, it exits and returns the group to add to or whatever. I was going to post some code for creating etc. but it's pretty trivial to do on the fly.
Any improvements/comments welcome.

Code: [Select]

Public Sub GroupFromEnt(group As AcadGroup, strprompt As String)
    ' Select an entity
   Dim returnObj As Object
   Dim basePnt As Variant
   ThisDrawing.Utility.GetEntity returnObj, basePnt, strprompt
   
   ' Get the groups
   Dim acadGroups As acadGroups
   Dim groupEntity As AcadEntity
   Dim isInGroup As Boolean
   Dim length As Integer
   Dim i As Integer
   
   Set acadGroups = ThisDrawing.groups
   isInGroup = False
   
   ' Iterate all available groups
   For Each group In acadGroups
      length = group.Count
          ' Get every entity from a group
       For i = 0 To length - 1
          Set groupEntity = group.Item(i)
          If groupEntity.Handle = returnObj.Handle Then
             ThisDrawing.Utility.Prompt "Entity is from Group " + group.Name
             isInGroup = True
             'let's go, we got it:
             Exit Sub
          End If
       Next i
    Next
    If isInGroup = False Then
       ThisDrawing.Utility.Prompt "Entity is in not in a group."
    End If
 End Sub


[Bryco]

Other than adding xdata that seems as good as you'll need mate. I looked at using vbassoc to find the reactor attached to each ent and it does work but I never could figure out a lisp entity name comparison to vba objectid.
Anyway it has kludge.
If you could add the xdata as you make the groups, I think you could use a selection set.

[MickD]

Yep, that's what I figured too, it will be interesting to see how the speed is once I get a fair few groups in the db though. Once I get the main bits sorted out I will be looking at data storage, mainly an ecs for length extraction and things like group name's etc to keep track of assemblies and parts, I may look at storing these outside the db though...I'll have to think about that a bit.

[Bryco]

I'ld still like to hear your argument for groups over blocks.

[MickD]

Well, with structural steel we start with a simple beam (the main shaft which will most likely be the group's 'parent'), as we model we need to add a cleat here or another part there as the model develops, we may also need to drill or cut the parts/main member along the way. If I used blocks I'd have to explode them to carry out modifications and re-create as far as I can see it, I'm open to new solutions though, a block would be better for a lot of reasons, att's being just one.

A group also gives you the ability to move parts as well, you can move the whole group at once by turning groups on or move a single part of the group after turning groups off (ctrl+shift+a or something, it's a reflex action these days )

At it's simplest, a group is just a selection set and that's fine, you can add and delete objects as you like, I'd just use the acad group dlg only it's very inadequate from a user's point of view, the groups list box is non sizable and only has 3/4 groups visible at once just for starters.

[MickD]

Actually Bryco, you just gave me an idea, before when I used groups I had to deepclone them and create another group in a new drawing or the drawing I was exporting to to keep the group and it's name intact, creating blocks out of the groups once the model is done would solve quite a few issues here, both for updates and export/import into other drg's (I could just use design centre for this too).

[It's Alive!]

I'ld still like to hear your argument for groups over blocks.

No argument from me   

I like Groups, I use the heck out of them.
I like Blocks, I use the heck out of them.

PS ,Mick.. I have successfully created my first DRX application w00t

[MickD]

For what it's worth, here's my code for creating and editing groups. It's a bit of a mess but you get that when you're in a hurry There is no doubt a few areas that need more error checking/handling but it works.

The idea is to be able to create groups of parts (assemblies) and these groups can not contain parts of other groups. When removing parts from the group you can't delete the 'main' or first part as it is the parent of the assembly if you like.

You can create, explode, add to and remove, hide a group and display all groups.

I'm going to take a quick look at creating groups of groups so you can hide an area/section of the model as needed, these groups have to be different to normal groups, the way I'm looking at doing this is with the 'selectable' property, we'll see.

Code: [Select]

Public Sub GroupFromEnt(group As AcadGroup, ent As AcadEntity, exists As Boolean)
   ' Get the groups, sets the group object if found.
   Dim groups As acadGroups, groupEntity As AcadEntity
   Dim length As Integer
   Dim i As Integer
   
   Set groups = ThisDrawing.groups
   
   ' Iterate all available groups
   For Each group In groups
      length = group.Count
       'Get every entity from a group
       For i = 0 To length - 1
          Set groupEntity = group.Item(i)
          If groupEntity.Handle = ent.Handle Then
             exists = True
             'let's go, we got it:
             Exit Sub
          End If
       Next i
    Next
 End Sub
 
Public Function IsInAGroup(ent As AcadEntity) As Boolean
'given an entity, it checks to see if it belongs to a group.
   ' Get the groups
   Dim group As AcadGroup, groups As acadGroups, groupEntity As AcadEntity
   Dim length As Integer
   Dim i As Integer
   
   Set groups = ThisDrawing.groups
   
   ' Iterate all available groups
   For Each group In groups
      length = group.Count
       'Get every entity from a group
       For i = 0 To length - 1
          Set groupEntity = group.Item(i)
          If groupEntity.Handle = ent.Handle Then
             IsInAGroup = True
             'let's go, we got it:
             Exit Function
          End If
       Next i
    Next
IsInAGroup = False
End Function

'************** Group user stuff *****************************'
Public Sub CreateGroup()
Dim strName As String
Dim returnObj As Object
Dim basePnt As Variant

On Error GoTo Exit_Error
ThisDrawing.Utility.GetEntity returnObj, basePnt, _
    "Select the main part for the group: "
'get the main part for the group, check to make sure it's a 3d solid:
While returnObj.ObjectName <> "AcDb3dSolid"
    ThisDrawing.Utility.GetEntity returnObj, basePnt, _
    "Select the main part for the group: "
Wend
 
Dim group As AcadGroup, groups As acadGroups
Dim isInGroup As Boolean

'check if it's in a group already:
GroupFromEnt group, returnObj, isInGroup
If isInGroup = True Then
    'group exists, lets leave:
    ThisDrawing.Utility.Prompt "Object is already in a group!"
    Exit Sub
End If
'if we got the part, get the group name from the user:
Dim groupName As String

groupName = ThisDrawing.Utility.GetString _
             (0, vbCrLf & "Enter group name (Press enter to accept default): ")
             
Set groups = ThisDrawing.groups
If groupName = "" Then
    'create the group using obj's handle for name:
    Set group = groups.Add(returnObj.Handle)
Else
    'create the group with the user name:
    Set group = groups.Add(groupName)
End If

'ask the user if they want to add any further parts to the group:
Dim SS1 As AcadSelectionSet
Dim FilterType1(0 To 0) As Integer
Dim FilterData1(0 To 0) As Variant

FilterType1(0) = 0
FilterData1(0) = "3DSOLID"

Set SS1 = vbdPowerSet("SS1")

Dim keyWord As String

ThisDrawing.Utility.InitializeUserInput 0, "Yes No"
keyWord = ThisDrawing.Utility.GetKeyword _
              (vbCrLf & "Do you want ot add parts to this group (Yes/No <No>): ")
If keyWord = "" Then keyWord = "No"
If keyWord = "Yes" Then 'if no, the sset count will be 0
    SS1.SelectOnScreen FilterType1, FilterData1
End If

'if yes, add them to the new group:
Dim tmpgroup As AcadGroup, solid As AcadEntity
Dim objs() As AcadEntity

'set up the array to take what's left:
ReDim objs(SS1.Count)
'add the main part to the new group:
Set objs(0) = returnObj
'now add the rest from the sset:
Dim i As Integer
i = 1 'we already added the first object, start at one.
If SS1.Count <> 0 Then
       For Each solid In SS1
            If IsInAGroup(solid) <> True Then
                If solid.Handle <> returnObj.Handle Then
                    Set objs(i) = solid
                    i = i + 1
                End If
            End If
       Next
End If
'add the objs to the group:
ReDim Preserve objs(i - 1)
group.AppendItems objs


Exit_Here:
Exit Sub
Exit_Error:
    Select Case Err.Number
    Case -2145386494 'not applicable
        Resume Next
    Case Else
        MsgBox Err.Description
        Resume Exit_Here
    End Select
End Sub

Public Sub ExplodeGroup()
'deletes a group from the groups collection
Dim group As AcadGroup, exists As Boolean
'get the group from the user
Dim returnObj As Object
Dim basePnt As Variant

ThisDrawing.Utility.GetEntity returnObj, basePnt, _
    "Select group to explode: "
GroupFromEnt group, returnObj, exists
If exists = True Then
    ThisDrawing.groups.Item(group.Name).Delete
End If
End Sub

Public Sub AddToGroup()
'deletes a group from the groups collection
Dim group As AcadGroup, exists As Boolean
'get the group from the user
Dim returnObj As Object
Dim basePnt As Variant

On Error GoTo Exit_Error
ThisDrawing.Utility.GetEntity returnObj, basePnt, _
    "Select group to add items to: "
GroupFromEnt group, returnObj, exists
If exists = False Then
    ThisDrawing.Utility.Prompt "Object is not a group!"
    Exit Sub
End If
'must be a group, get items to add:
Dim SS1 As AcadSelectionSet
Dim FilterType1(0 To 0) As Integer
Dim FilterData1(0 To 0) As Variant

FilterType1(0) = 0
FilterData1(0) = "3DSOLID"
Set SS1 = vbdPowerSet("SS1")
SS1.SelectOnScreen FilterType1, FilterData1

Dim i As Integer, solid As AcadEntity
Dim objs() As AcadEntity
ReDim objs(SS1.Count - 1)
i = 0
If SS1.Count <> 0 Then
       For Each solid In SS1
            If IsInAGroup(solid) <> True Then
                Set objs(i) = solid
                i = i + 1
            End If
       Next
End If
'add the objs (if any) to the group:
ReDim Preserve objs(i - 1)
group.AppendItems objs
Exit_Here:
Exit Sub
Exit_Error:
    Select Case Err.Number
    Case -2145386494 'not applicable
        Resume Next
    Case Else
        MsgBox Err.Description
        Resume Exit_Here
    End Select
End Sub

Public Sub RemoveFromGroup()
'removes selected items from a selected group.
Dim group As AcadGroup, exists As Boolean
'get the group from the user
Dim returnObj As Object
Dim basePnt As Variant

On Error GoTo Exit_Error
'check pickstyle so we don't pick groups:
Dim pstyle As Integer

pstyle = ThisDrawing.GetVariable("PICKSTYLE")
If pstyle = 1 Then
    ThisDrawing.SetVariable "PICKSTYLE", 0
End If

ThisDrawing.Utility.GetEntity returnObj, basePnt, _
    "Select group to remove items from: "
GroupFromEnt group, returnObj, exists
If exists = False Then
    ThisDrawing.Utility.Prompt "Object is not a group!"
    Exit Sub
End If
'must be a group, get items to remove:
Dim SS1 As AcadSelectionSet
Dim FilterType1(0 To 0) As Integer
Dim FilterData1(0 To 0) As Variant

FilterType1(0) = 0
FilterData1(0) = "3DSOLID"
Set SS1 = vbdPowerSet("SS1")
SS1.SelectOnScreen FilterType1, FilterData1

Dim i As Integer, solid As AcadEntity
Dim objs() As AcadEntity
ReDim objs(SS1.Count - 1)
i = 0
If SS1.Count <> 0 Then
       For Each solid In SS1
            'we don't want to remove the main part of the group:
            If solid.Handle <> group.Item(0).Handle Then
                Set objs(i) = solid
                i = i + 1
            End If
       Next
End If
'remove the objs (if any) to the group:
If i > 0 Then
    ReDim Preserve objs(i - 1)
    group.RemoveItems objs
End If

'reset pickstyle:
ThisDrawing.SetVariable "PICKSTYLE", pstyle

Exit_Here:
ThisDrawing.SetVariable "PICKSTYLE", pstyle
Exit Sub
Exit_Error:
    Select Case Err.Number
    Case -2145386494 'not applicable
        Resume Next
    Case Else
        MsgBox Err.Description
        Resume Exit_Here
    End Select
End Sub

Public Sub HideGroup()
'hides a selected group.
Dim group As AcadGroup, exists As Boolean
'get the group from the user
Dim returnObj As Object
Dim basePnt As Variant

On Error GoTo Exit_Error

ThisDrawing.Utility.GetEntity returnObj, basePnt, _
    "Select group to hide: "
GroupFromEnt group, returnObj, exists
If exists = False Then
    ThisDrawing.Utility.Prompt "Object is not a group!"
    Exit Sub
End If

group.Visible = False

Exit_Here:
Exit Sub
Exit_Error:
    Select Case Err.Number
    Case -2145386494 'not applicable
        Resume Next
    Case Else
        MsgBox Err.Description
        Resume Exit_Here
    End Select
End Sub

Public Sub DisplayGroups()
'iterates the groups collection and makes them all visible:
Dim group As AcadGroup, groups As acadGroups

Set groups = ThisDrawing.groups

For Each group In groups
    group.Visible = True
Next
End Sub

<edit> fixed prompts so they made sense

[Bryco]

looks good Mick