Author Topic: Groups in vba  (Read 8547 times)

0 Members and 1 Guest are viewing this topic.

It's Alive!

  • Retired
  • Needs a day job
  • Posts: 8661
  • AKA Daniel
Re: Groups in vba
« Reply #15 on: January 10, 2008, 08:02:00 AM »
I'ld still like to hear your argument for groups over blocks.

No argument from me   :-P

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

  • King Gator
  • Posts: 3619
  • (x-in)->[process]->(y-out) ... simples!
Re: Groups in vba
« Reply #16 on: January 14, 2008, 04:09:40 PM »
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
« Last Edit: January 14, 2008, 05:13:01 PM by MickD »
"Short cuts make long delays,' argued Pippin.”
J.R.R. Tolkien

Bryco

  • Water Moccasin
  • Posts: 1882
Re: Groups in vba
« Reply #17 on: January 14, 2008, 05:49:28 PM »
looks good Mick