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
