TheSwamp
Code Red => VB(A) => Topic started by: MickD on January 08, 2008, 09:53:31 PM
-
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.
-
Don't have vb group code, would lisp code from an old guy be of any (translation) use?
-
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. :roll:
-
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
-
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
-
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.
-
Hey Mick, Sorry to highjack your thread... I got pretty far in making .NET wrappers for SDS. Far enough to do this.
//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. :evil:
Anyway, it might be possible to access DRX,SDS and COM all from C#..
-
'...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.
-
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. :evil:
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.
-
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.
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
-
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.
-
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.
-
I'ld still like to hear your argument for groups over blocks.
-
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.
-
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).
-
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
-
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.
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
-
looks good Mick