Blocks on the same layer To group

[stefan.hofer]

My script in VBA works perfect. Now i try to do the same with NET, but nothing happens.

here is the code:

    Public Function CreateSelectionSet(ByVal SelectionSet As AcadSelectionSet, _
    ByVal FilterCode As Integer, _
    ByVal FilterValue As String) As Boolean
        Dim iFilterCode(0) As Integer
        Dim vFilterValue(0) As Object

        iFilterCode(0) = FilterCode
        vFilterValue(0) = FilterValue

        SelectionSet.Select(AcSelect.acSelectionSetAll, , , iFilterCode, vFilterValue) '<-VB.NET
        'SelectionSet.Select acSelectionSetAll, , , iFilterCode, vFilterValue '<- VBA

        If SelectionSet.Count Then
            CreateSelectionSet = True
        End If
    End Function

    <Autodesk.AutoCAD.Runtime.CommandMethod("GROUPLAYER")> _
    Public Sub GroupLayer()

        On Error GoTo ErrTrap
        Dim objEnts() As AcadEntity
        Dim intIndex As Integer
        Dim objGrp As AcadGroup

        Dim LayerName As String
        Dim oBlkRef As AcadBlockReference
        Dim basePnt As Object
        ThisDrawing.Utility.GetEntity(oBlkRef, basePnt, "Layer zu Gruppe -> Objekt wählen...")
        LayerName = oBlkRef.Layer

        Dim iType(0) As Integer
        Dim objSS As AcadSelectionSet
        iType(0) = 8

        On Error Resume Next
        'delete any previous selection set
        ThisDrawing.SelectionSets("Entities").Delete()
        'create our new selection set
        objSS = ThisDrawing.SelectionSets.Add("Entities")
        'get the actual entities for the selection set
        CreateSelectionSet(objSS, iType(0), LayerName)

        'Gruppe erstellen
        ReDim objEnts(objSS.Count - 1)
        For intIndex = LBound(objEnts) To UBound(objEnts)
            objEnts(intIndex) = objSS(intIndex)
        Next intIndex
        objGrp = ThisDrawing.Groups.Add("*")
        objGrp.AppendItems(objEnts)

ErrTrap:
        Err.Clear()
    End Sub

 I can select something, but nothing happens...

where is the error?

[norman.yuan]

Have you stepped through your code in debugging, which could reveal the cuase of your issue easily?

Firstly, never use On Error Resume Next without examine Err object after every line of code if you code may run into unexpected exceptions (often one can NEVER be asure of this). In your case, this is the answert to your question ("Where is the error"). Since you have already moved to VB.NET, you should use more friendly Try...Catch...exception handling structure instead.

Secondly, if the SelectionSet is actually created, I'd bet it may contains 0 entity. Since CreateSelection() is a function returning True/False, you should call it coorectly:

If CreateSelectionSet(....) Then

    'Group things

Else

    'Prompt user for no entity being selected, if necessary

End

This way, at least you will be clear that "nothing happens" could be the result of no entity being selected.

Thirdly, If your intetion is to select only block references on certain layer, you may want to redefine your filter group code to combine both "LAYER" and "INSERT" as filter. Otherwise, as your cdoe, any entity on the layer, being block or not, will also be selelcted and placed into the group.

Finally, now that you are doing .NET, why use COM API instead of .NET API?

[stefan.hofer]

... right, it was nothing selected.

i replaced the "FilterType As Integer" with Short and now it works.

i'm not good with vba and i'm a newbie with NET, -> no errors = perfect for me.

here is my code, works (okay you still get errors if you dont pick a Block) but who cares.

    <Autodesk.AutoCAD.Runtime.CommandMethod("GROUPLAYER")> _
    Public Sub GroupLayer()

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

        Dim LayerName As String
        Dim oBlkRef As AcadBlockReference
        Dim basePnt As Object
        ThisDrawing.Utility.GetEntity(oBlkRef, basePnt, "Layer zu Gruppe -> Block wählen...")
        LayerName = oBlkRef.Layer

        Dim objSS As AcadSelectionSet
        Dim FilterType(0 To 1) As Short
        Dim FilterData(0 To 1) As Object

        FilterType(0) = 0
        FilterData(0) = "INSERT"
        FilterType(1) = 8
        FilterData(1) = LayerName

        Dim FilterTypeObject As Object
        Dim FilterDataObject As Object
        FilterTypeObject = FilterType
        FilterDataObject = FilterData

        'Bestehendes SelectionSet Löschen
        For i = 0 To ThisDrawing.SelectionSets.Count - 1
            If ThisDrawing.SelectionSets.Item(i).Name = "Entities" Then
                ThisDrawing.SelectionSets.Item(i).Delete()
            End If
        Next i

        'SelectionSet Erstellen
        objSS = ThisDrawing.SelectionSets.Add("Entities")
        objSS.Select(AcSelect.acSelectionSetAll, , , FilterTypeObject, FilterDataObject) '<-VB.NET

        'Gruppe erstellen
        ReDim objEnts(objSS.Count - 1)
        For intIndex = LBound(objEnts) To UBound(objEnts)
            objEnts(intIndex) = objSS(intIndex)
        Next intIndex
        objGrp = ThisDrawing.Groups.Add("*")
        objGrp.AppendItems(objEnts)

    End Sub

ty for help.

[norman.yuan]

You'd better still test whether the SelectionSet.Count>0 or not before this line

ReDim objEnts(objSS.Count - 1)

If the SelectionCount=0 for some reason, the "ReDim" statement would raise Exception and your command would crash AutoCAD, which I assume you do care.

[stefan.hofer]

okay.

i added the "On Error GoTo" Line again. I get no warnings or errors now.

Public Sub GroupLayer()
	On Error GoTo ErrTrap
	...
	..


        'SelectionSet Erstellen
        objSS = ThisDrawing.SelectionSets.Add("Entities")
        objSS.Select(AcSelect.acSelectionSetAll, , , FilterTypeObject, FilterDataObject) '<-VB.NET

        'Prüfen ob Selectionset nicht leer
        If objSS.Count > 0 Then

            'Gruppe erstellen
            ReDim objEnts(objSS.Count - 1)
            For intIndex = LBound(objEnts) To UBound(objEnts)
                objEnts(intIndex) = objSS(intIndex)
            Next intIndex
            objGrp = ThisDrawing.Groups.Add("*")
            objGrp.AppendItems(objEnts)
        End If
ErrTrap:
        Err.Clear()
End Sub

[Balaji_Ram]

Here is a code snippet that makes a group out of all the blocks in a specified layer.

<CommandMethod(

"Test")> _

Public Sub commandMethodTest()

Dim activeDoc As Document = Application.DocumentManager.MdiActiveDocument

Dim db As Database = activeDoc.Database

Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor

Dim pso As New PromptStringOptions(

"Layer Name :")

pso.DefaultValue =

"0"

pso.AllowSpaces = False

Dim pr As PromptResult = ed.GetString(pso)

If pr.Status <> PromptStatus.OK Then

Return

End If

Dim filterData As TypedValue() = {

New TypedValue(CInt(DxfCode.LayerName), pr.StringResult),

New TypedValue(CInt(DxfCode.Start),

"INSERT")

}

Dim selFilter As New SelectionFilter(filterData)

Dim promptReslt As PromptSelectionResult = ed.SelectAll(selFilter)

Dim ss As SelectionSet = promptReslt.Value

If ss IsNot Nothing AndAlso ss.Count > 0 Then

Using tr As Transaction = db.TransactionManager.StartTransaction()

Dim gd As DBDictionary = DirectCast(tr.GetObject(db.GroupDictionaryId, OpenMode.ForWrite), DBDictionary)

Dim grp As New Group(pr.StringResult, True)

Dim ids As New ObjectIdCollection(ss.GetObjectIds())

grp.Append(ids)

gd.SetAt(pr.StringResult, grp)

tr.AddNewlyCreatedDBObject(grp, True)

tr.Commit()

End Using

End If

End Sub

[Anonymous]

Balaji,

I was trying to use your code to create a group and add three specific objects to it stored in memory.  Part of my difficulty is that this program was started with AutoCAD Interop objects and not leveraging the DatabaseServices model.      I attempted to first use the Acadgroup object to achieve this but with no luck.  So far I have the following code to create a group and add 3 objects to it (mtext, block, table).  Please note, this code is not pretty and is a mismash of interop code and databaseservices; please don't cringe too much.

Ultimately, the code creates the group succesfully in model space but does not create the group if I go to the Groups window.  I was hoping that you could possibly help me figure out what I was doing wrong and also direct me to a source where I could better understand some of the functions used below (SetAt, the declaration of the DBDictionary, etc.).  I am still fairly new to AutoCAD .net programming and a resource such as an MSDN type class breakdown would be very much appreciated.

Dim activeDoc As Autodesk.AutoCAD.ApplicationServices.Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
Dim db As Database = activeDoc.Database
Using tr As Transaction = db.TransactionManager.StartTransaction()
Dim gd As DBDictionary = DirectCast(tr.GetObject(db.GroupDictionaryId, OpenMode.ForWrite), DBDictionary)
Dim grp As New Group("MESCHGroup", True)
'Dim ids As New ObjectIdCollection(ss.GetObjectIds)
Dim ids As New ObjectIdCollection()
Dim oid1 As New ObjectId(headerBlock.ObjectID)
ids.Add(oid1)
Dim oid2 As New ObjectId(mt.ObjectID)
ids.Add(oid2)
Dim oid3 As New ObjectId(HVACtable.ObjectID)
ids.Add(oid3)

Try
grp.Append(ids)
gd.SetAt("*", grp)
tr.AddNewlyCreatedDBObject(grp, True)
Catch ex As Exception
MsgBox(ex.Message)
End Try

tr.Commit()
End Using

Thanks,

Mike

[Anonymous]

Just as a follow up to my question, I was able to get this working using interop objects with the following code:

Dim meschgroup As AcadGroup = ThisDrawing.Groups.Add("MESCHGroup")
Dim oarray As AcadEntity() = {mt, headerBlock, HVACtable}
Try
meschgroup.AppendItems(oarray)
Catch ex As Exception
MsgBox(ex.Message)
End Try

Any help in directing me towards documentation of the databaseservices model would still be greatly appreciated.

[Balaji_Ram]

Hi Mike,

Sorry for not getting back to you in time for your recent query.

Good to know that you have found the solution.

Regarding the class hierarchy, you can refer to the <ObjectARX foder>\Classmap\classmap.dwg

It has the class hierarchy for the ObjectARX and .Net classes.

The managed API documentation (arxmgd.chm) can be helpful if you are tracking the class hierarchy for a given class. If you search for example, "Line class", you can then click through the class hierarchy to find its base classes.

Hope this helps.