VB.Net Filter Layout, Layer, and Block

Anonymous · ‎11-21-2013

Hello,

I am not familiar - yet - with VB.Net so may be someone could help me on this.

In an Excel File (test.xlsm) I have in :

Cell A1 an Autocad Layout Name

Cell A2 an Autocad Block Name

Cell A3 an Autocad Layer Name

From VB.net, how can I set the Filter based on the 3 parameters above ?

I have done a Code in VBA but can not figure out how to convert it in VB.Net

            grpCode(0) = 8   ' Layer
            grpCode(1) = 2   ' Block Name
            grpCode(2) = 410 ' Layout
            filtertype = grpCode

            ' Filter on Layout Name
            grpValue(2) = xlsSheetTwo.Cells(1, 1).text

            ' Filter on BLOCK Name
            grpValue(1) = xlsSheetTwo.Cells(2, 1).text

            ' Filter on LAYER Name
            grpValue(0) = xlsSheetTwo.Cells(3, 1).text

            filterData = grpValue

SelSet.Select(AutoCAD.AcSelect.acSelectionSetAll, , , filterType, filterData)

For i = 0 To SelSet.Count - 1
Entity = SelSet.Item(i)

Thank you

Herve

Hallex · ‎11-22-2013

Try this example

        ' Requre
        ' Imports System.Runtime.InteropServices

        ' Open an Autocad drawing 
        ' Type the command "Netload" in the command line and press enter
        ' Locate and load the your .dll file  
        ' Minimize Autocad and then Open Excel
        ' Select desired Excel range  
        ' Minimize Excel (insure your cells are still selected)
        ' Restore your Autocad drawing
        ' Type the command "blksel" in the command line and press enter
        ' Repeat the process for another block

        <CommandMethod("blksel")> _
        Public Sub testBlockSelection()
            Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
            Dim ed As Editor = doc.Editor
            Dim excelRange As String
            Dim layerName As String
            Dim blockName As String
            Dim layoutName As String
            Try
                excelRange = My.Computer.Clipboard.GetText()
            Catch exc As System.IndexOutOfRangeException
                'ed.WriteMessage(vbLf + "Select Excel range again!" + vbLf)
                ' ed.WriteMessage(vbLf + exc.ToString())
                Autodesk.AutoCAD.ApplicationServices.Application.ShowAlertDialog("Select Excel range again!")
                Return
            End Try

            ' if cells are per column like A1, A2, A3 use this code block

            Dim dataArray As String() = excelRange.Split(vbCrLf)
            layerName = dataArray(0).Trim(vbLf, vbTab)
            blockName = dataArray(1).Trim(vbLf, vbTab)
            layoutName = dataArray(2).Trim(vbLf, vbTab)
            '-----------------------------------------

            ' if cells are per row like A1, B1, C1 use this code block
            'Dim dataArray As String() = excelRange.Split(vbTab)
            'layerName = dataArray(0).Trim(vbLf, vbCrLf)
            'blockName = dataArray(1).Trim(vbLf, vbCrLf)
            'layoutName = dataArray(2).Trim(vbLf, vbCrLf)
            '-----------------------------------------

            'ed.WriteMessage(vbLf + "Layer: ""{0}"" Block: ""{1}""  Layout: ""{2}""" + vbLf, layerName, blockName, layoutName)

            Dim filter As TypedValue() = {New TypedValue(DxfCode.Operator, "<and"), _
                                          New TypedValue(DxfCode.Start, "insert"), _
                                          New TypedValue(DxfCode.BlockName, blockName), _
                                          New TypedValue(DxfCode.LayerName, layerName), _
                                          New TypedValue(DxfCode.LayoutName, layoutName), _
                                          New TypedValue(DxfCode.Operator, "and>")}

            Dim pres As PromptSelectionResult = ed.SelectAll(New SelectionFilter(filter))

            If pres.Status <> PromptStatus.OK Then
                Return
            End If

            Dim sset As SelectionSet = pres.Value
            If sset.Count = 0 Then Return
            ' highlight selection
            ed.SetImpliedSelection(sset)
            ed.WriteMessage(vbLf + "Selected {0}  blocks {1} in layout {2} on layer {3}" + vbLf, sset.Count, blockName, layoutName, layerName)
            Using tr As Transaction = doc.TransactionManager.StartTransaction()
                Dim id As ObjectId = ObjectId.Null

                For Each selObj As SelectedObject In sset
                    id = selObj.ObjectId
                    Dim ent As Entity = TryCast(tr.GetObject(id, OpenMode.ForRead, False, False), Entity)
                    If ent Is Nothing Then Return
                    ent.UpgradeOpen()
                    Dim blockRef As BlockReference = TryCast(ent, BlockReference)
                    If blockRef Is Nothing Then Return

                    ''  ---   do your next work with block after  ---   ''
                Next
                tr.Commit()
            End Using
            ' clear the clipboard, optional
            ' My.Computer.Clipboard.Clear()
        End Sub

_____________________________________
C6309D9E0751D165D0934D0621DFF27919

Anonymous · ‎11-22-2013

Hello Hallex and thanks for the code.
I did not try it yet but it seems i am working the other way round. In my exe (visual studio) i am opening excel where i have more than 100 autocad files names. I am looking at retreiving the block attributs for a particular block and go to the next file. I do not intend to use the netload cmd.

Thanks anyway

Hallex · ‎11-22-2013

Methink you would be use this one:

http://closedxml.codeplex.com/

_____________________________________
C6309D9E0751D165D0934D0621DFF27919

Anonymous · ‎11-22-2013

Hello again,

Here below the vb.net I made so far but the Selection count seems not working.

From my VS2010 application, I open an excel file, and retreive all the Autocad file names that are in a a particular folder (that part of the code is working fine)

After, I open the 1st Autocad file (that is stored in excel - working fine)

And I want to set a filter based on the Layout + Layer + Block Name (the 3 parameters are stored in the Excel Sheet - seems NOT working)

and I want to retreive the attributs of that filtered Block in excel. and go to the next Autocad file and repeat the filter and retreive.

The issue is the Selection count seems not to be ok; actually, the autocad file open correctly but as the filter is not ok, the code close the Autocad file and goes to the next one...till the last file.

I am missing something.

Thank you

Imports Microsoft.Office.Interop
Imports System.Data.SqlClient
Imports System.Data.OleDb
Imports System.IO
Imports Autodesk.AutoCAD.Interop
Imports System
Imports System.Runtime.InteropServices
Imports Excel = Microsoft.Office.Interop.Excel



    Sub Import()
        xlsApp = New Excel.Application
        xlsApp.Visible = True
        xlsWB = xlsApp.Workbooks.Open(Frm_Main.LblFile1.Text)
        xlsSheetTwo = xlsWB.Worksheets("Import")

        Dim a As Integer
        a = 5
        Dim dirInfo As New DirectoryInfo(Frm_Main.LblFolder1.Text)
        Dim fileInfo As FileInfo
        For Each fileInfo In dirInfo.GetFiles("*.dwg") 'dwg for Autocad
            xlsSheetTwo.Cells(a, 1) = fileInfo.Name
            a = a + 1
        Next

        Dim AcadApp As AutoCAD.AcadApplication
        Dim SelSet As AutoCAD.AcadSelectionSet
        Dim Entity As AutoCAD.AcadEntity
        Dim BlocRef As AutoCAD.AcadBlockReference
        Dim filterType As Object
        Dim filterData As Object

        Dim p1(0 To 2) As Double
        Dim p2(0 To 2) As Double

        Dim grpCode(0 To 2) As Integer
        Dim grpValue(0 To 2) As String

        Dim i, Row, j, Column As Integer
        Dim Attributes As Object
        Dim ColumnExist As Boolean

        xlsSheetTwo.Select()
        ' Delete Excel records
        xlsSheetTwo.Range("B5:TZ65536").ClearContents()

        xlsApp.Application.Visible = True

        ' AutoCAD Connection
        On Error Resume Next
        AcadApp = GetObject(, "AutoCAD.Application")
        On Error GoTo 0
        If AcadApp Is Nothing Then
            AcadApp = New AutoCAD.AcadApplication
        End If
        AcadApp.Visible = True

        'Open the DWG
        Dim Opened As Boolean
        Opened = False

        Dim k As Integer
        k = 5
        Row = 5
        For k = 5 To xlsSheetTwo.Range("A65536").End(Excel.XlDirection.xlUp).Row

            AcadApp.Documents.Open(Frm_Main.LblFolder1.Text & "\" & xlsSheetTwo.Cells(k, 1).Text)

            On Error Resume Next
            SelSet = AcadApp.ActiveDocument.SelectionSets.Add("SELSET")
            If ErrorToString() <> 0 Then
                SelSet = AcadApp.ActiveDocument.SelectionSets.Item("SELSET")
                SelSet.Clear()
            End If

            'Creation of Filter
            grpCode(0) = 8   ' Layer
            grpCode(1) = 2   ' Block Name
            grpCode(2) = 410 ' Layout
            filtertype = grpCode

            ' Filter on Layout Name
            grpValue(2) = xlsSheetTwo.Cells(1, 3).text

            ' Filter on BLOCK Name
            grpValue(1) = xlsSheetTwo.Cells(2, 3).text

            ' Filter on LAYER Name
            grpValue(0) = xlsSheetTwo.Cells(3, 3).text

            filterData = grpValue

            SelSet.Select(AutoCAD.AcSelect.acSelectionSetAll, , , filterType, filterData)

            ' Go throuhg Selection
            For i = 0 To SelSet.Count - 1
                Entity = SelSet.Item(i)

                If Entity.ObjectName = "AcDbBlockReference" Then
                    BlocRef = Entity

                    If BlocRef.HasAttributes Then
                        Attributes = BlocRef.GetAttributes
                        For j = LBound(Attributes) To UBound(Attributes)
                            Column = 3
                            ColumnExist = False
                            While Not String.IsNullOrEmpty(xlsSheetTwo.Cells(4, Column))

                                If xlsSheetTwo.Cells(4, Column).Text = Attributes(j).TagString Then
                                    xlsSheetTwo.Cells(Row, Column).Value = Attributes(j).TextString
                                    ColumnExist = True
                                End If
                                Column = Column + 1 ' On passe à la colonne suivante
                            End While

                            If Not ColumnExist Then
                                xlsSheetTwo.Cells(4, Column).Value = Attributes(j).TagString
                                xlsSheetTwo.Cells(Row, Column).Value = Attributes(j).TextString
                            End If
                        Next ' Next Attribut
                    End If
                End If
            Next

            AcadApp.ActiveDocument.Close()
            Row = Row + 1   'Next Line
        Next k
        AcadApp.Quit()
        MsgBox("Attributs of " & xlsSheetTwo.Cells(2, 1).Text & " have been retreived.")

    End Sub
End Module

Hallex · ‎11-26-2013

Hi Herve,

You have to declare 'grpCode' as Short or Int32,

also you need to cast all objects as desired type, see

changes within the code

Try this first from your form,

hope it will helps

Cheers

    'Imports System
    'Imports System.IO
    'Imports System.Text
    'Imports Autodesk.AutoCAD.Interop
    'Imports Autodesk.AutoCAD.Interop.Common
    'Imports System.Data.SqlClient
    'Imports System.Data.OleDb
    'Imports Microsoft.Office.Interop
    'Imports System.Runtime.InteropServices
    'Imports Excel = Microsoft.Office.Interop.Excel
    'Imports AutoCAD = Autodesk.AutoCAD.Interop

    'Change "MyDrawing.dwg" on your drawing name you have
    'in your folder, same with layer, layout and block name


    Public Sub testAcad()
        Dim AcadApp As AutoCAD.AcadApplication
        Dim SelSet As AutoCAD.AcadSelectionSet
        Dim Entity As AutoCAD.Common.AcadEntity
        Dim BlocRef As AutoCAD.Common.AcadBlockReference
        Dim filterType As Object
        Dim filterData As Object

        Dim grpCode(0 To 2) As Int16
        Dim grpValue(0 To 2) As Object

        Dim Attributes As Object

        ' AutoCAD Connection
        On Error Resume Next
        AcadApp = GetObject(, "AutoCAD.Application")
        On Error GoTo 0
        If AcadApp Is Nothing Then
            AcadApp = New AutoCAD.AcadApplication
        End If
        AcadApp.Visible = True
        AcadApp.Documents.Open(Me.LblFolder1.Text & "\" & "MyDrawing.dwg") 'xlsSheetTwo.Cells(k, 1).Text)
        On Error Resume Next
        SelSet = AcadApp.ActiveDocument.SelectionSets.Add("SELSET")
   
        'Creation of Filter
        grpCode(0) = 8   ' Layer
        grpCode(1) = 2   ' Block Name
        grpCode(2) = 410 ' Layout
        filterType = grpCode
        ' Filter on LAYER Name
        grpValue(0) = "MyLayer"  'xlsSheetTwo.Cells(3, 3).text
        ' Filter on BLOCK Name
        grpValue(1) = "MyBlock" 'xlsSheetTwo.Cells(2, 3).text
        ' Filter on Layout Name
        grpValue(2) = "MyLayout" 'xlsSheetTwo.Cells(1, 3).text

        filterData = grpValue

        SelSet.Select(AcSelect.acSelectionSetAll, , , filterType, filterData)
        Dim i As Integer
        ' Go throuhg Selection
        For Each obj As Object In SelSet
            Entity = DirectCast(obj, AcadEntity)
            If TypeOf Entity Is AcadBlockReference Then
                BlocRef = DirectCast(Entity, AcadBlockReference)
                If BlocRef.HasAttributes Then
                    Attributes = BlocRef.GetAttributes
                    For j = LBound(Attributes) To UBound(Attributes)
                        Dim Attref As AutoCAD.Common.AcadAttributeReference
                        Attref = DirectCast(Attributes(j), AutoCAD.Common.AcadAttributeReference)
                        Attref.TextString = "Blah-" & (j + i).ToString()
                        Attref.Update()
                        i += 1
                    Next ' Next Attribut
                    BlocRef.Update()
                End If
            End If
        Next
        SelSet = Nothing
        MessageBox.Show("Close form")
    End Sub

_____________________________________
C6309D9E0751D165D0934D0621DFF27919

Anonymous · ‎11-28-2013

Thank you Hallex,

I reworked a bit the code to suit my Application however, I have the following issue:

When I run the Code in Debugger Mode (I put a Breakpoint somewhere before the Autocad Open cmd) the macro is working very well.

When I compile my App and run the Code, sometimes For the first Autocad File, the Attributes are not retreived in Excel...

Is that posible the Autocad File is not open and the code keep running so it is why the first file is not treated?

Thanks you

Herve

Here attached the Code I have.

Community

VB.Net Filter Layout, Layer, and Block

VB.Net Filter Layout, Layer, and Block

VB.Net Filter Layout, Layer, and Block