VB.Net Adding predefined dictionaries to LibraryWithMedia - vb.net

I'm creating an application where I have different libraries, books and non-book media stored in dictionaries and displayed in listboxes. The user can add and remove additional dictionaries for any of these elements.
I have a listbox for "Books at Current library" and "Non-Book Media at Current Library" Which will display the media that is linked to the specific library that is highlighted in the listbox. And the user can freely add and remove different media to the library.
I'm having issues adding predefined associations together on frmAssociationScreen. I want to hardcode a few associations to LibraryWithMedia Where "Zahnow Library" will have Keys: 101 and 104 which are displayed in the "Books at Current Library" listbox before adding any from lstAllBooks.
Screenshots of the two forms:
frmManager: https://prnt.sc/mnd8qf
frmAssociationScreen: https://prnt.sc/mnd8sh
The three ways I've tried to implement but failed on frm_Load
frmManager.LibraryWithMedia("Zahnow Library").dicBooks.Add("101", "Zen and the Art of Appliance Wiring")
frmManager.EquippedLibrary(lstAllLibraries.SelectedIndex).dicBooks.Add("104", "Data Structures for Fun and Profit")
tmp = New frmManager.LibraryWithMedia(frmManager.Libraries.Keys(0))
tmp.dicBooks.Add("101", "Zen and the Art of Appliance Wiring")
Sub frmAssociationScreen_Load
Private Sub frmAssociationScreen_Load(sender As Object, e As EventArgs) Handles Me.Load
Dim tmp As frmManager.LibraryWithMedia
lstAllLibraries.Items.Clear()
For Each library In frmManager.Libraries
lstAllLibraries.Items.Add(library.Value & " --- " & library.Key)
Next
For Each book In frmManager.Books
lstAllBooks.Items.Add(book.Value & " --- " & book.Key)
Next
For Each nonBook In frmManager.nonBookMedia
lstAllMedia.Items.Add(nonBook.Value & " --- " & nonBook.Key)
Next
' The code i'm struggling to implement
' Three different ways I've tried to implement it
' construct equipped library and define the library names
frmManager.EquippedLibrary = New List(Of frmManager.LibraryWithMedia)
frmManager.LibraryWithMedia("Zahnow Library").dicBooks.Add("101", "Zen and the Art of Appliance Wiring")
frmManager.EquippedLibrary(lstAllLibraries.SelectedIndex).dicBooks.Add("104", "Data Structures for Fun and Profit")
tmp = New frmManager.LibraryWithMedia(frmManager.Libraries.Keys(0))
tmp.dicBooks.Add("101", "Zen and the Art of Appliance Wiring")
' initialise each library with book/media dictionary
populateEquippedLibNames()
End Sub
frmManager:
Public Class frmManager
Public Libraries As New Dictionary(Of String, String)
Public Books As New Dictionary(Of String, String)
Public nonBookMedia As New Dictionary(Of String, String)
Public EquippedLibrary As New List(Of LibraryWithMedia)
Structure LibraryWithMedia
Dim strLibraryName As String
Dim dicBooks As Dictionary(Of String, String)
Dim nonBookMedia As Dictionary(Of String, String)
Sub New(ByVal LibName As String)
strLibraryName = LibName
dicBooks = New Dictionary(Of String, String)
nonBookMedia = New Dictionary(Of String, String)
End Sub
End Structure
Private Sub frmManager_Load(sender As Object, e As EventArgs) Handles Me.Load
Libraries.Add("SVSU", "Zahnow Library")
Libraries.Add("BR", "Fleschner Memorial Library")
Libraries.Add("SDJ", "Scott D. James Technical Repository")
Books.Add("104", "Data Structures for Fun and Profit")
Books.Add("103", "Doing More With Less - Naval Lint Art")
Books.Add("102", "Interpretive Klingon Poetry")
Books.Add("105", "Programming with the Bidgoli")
Books.Add("101", "Zen and the Art of Appliance Wiring")
nonBookMedia.Add("201", "CD - IEEE Computer: the Hits")
nonBookMedia.Add("203", "DVD - Databases and You: the Video Experience")
nonBookMedia.Add("202", "DVD - The Pirates of Silicon Valley")
populatelstLibrary()
populatelstBooks()
populatelstBookMedia()
End Sub
frmAssociationScreen:
Public Class frmAssociationScreen
Sub populateEquippedLibNames()
Dim counter As Integer
Dim tmpSingleLib As frmManager.LibraryWithMedia
For counter = 0 To frmManager.Libraries.Count - 1
tmpSingleLib = New frmManager.LibraryWithMedia(frmManager.Libraries.Values(counter))
frmManager.EquippedLibrary.Add(tmpSingleLib)
tmpSingleLib = Nothing
Next
End Sub
populateLstLibrary()
Sub populatelstLibrary()
lstLibraries.Items.Clear()
For Each library In Libraries
lstLibraries.Items.Add(library.Value & " --- " & library.Key)
Next
End Sub
populatelstBooks()
Sub populatelstBooks()
lstBooks.Items.Clear()
For Each book In Books
lstBooks.Items.Add(book.Value & " --- " & book.Key)
Next
End Sub
populatelstBookMedia()
Sub populatelstBookMedia()
lstBookMedia.Items.Clear()
For Each bookMedia In nonBookMedia
lstBookMedia.Items.Add(bookMedia.Value & " --- " & bookMedia.Key)
Next
End Sub

Try this
For Each library As frmManager.LibraryWithMedia In frmManager.EquippedLibrary
If library.strLibraryName = "Zahnow Library" Then
library.dicBooks.Add("101", "Zen and the Art of Appliance Wiring")
End If
Next
Or to select the items from the listbox, use
For Each library As frmManager.LibraryWithMedia In frmManager.EquippedLibrary
If library.strLibraryName = lstAllLibraries.Text Then
library.dicBooks.Add("101", "Zen and the Art of Appliance Wiring")
End If
Next

Related

Copy files with multiple search criteria

I'm trying to copy files in a directory into a new folder. The script works on one file type, but I have 6 types I need to search for. I thought I could use a bar ("|") like you can with a Regex but that didn't work. Then I tried using an array and had no luck there.
Public Class Form1
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles btnMove.Click
Dim sourceDir As String
sourceDir = txtMovePath.Text
Dim foundFile As Object = Nothing
Dim graphicsFldr As String
graphicsFldr = sourceDir + "\Graphics\"
For Each foundFile In My.Computer.FileSystem.GetFiles(sourceDir, _
Microsoft.VisualBasic.FileIO.SearchOption.SearchTopLevelOnly, _
"*.cgm|*.eps|*.svg|*.wmf|*.jpg|*.png|*.iso")
My.Computer.FileSystem.CopyFile(foundFile, graphicsFldr & My.Computer.FileSystem.GetName(foundFile))
Next
End Sub
End Class
Module mainModule
Sub Main()
Form1.Show()
End Sub
Use this
Dim arr = {"*cgm","*.eps","*.svg","*.wmf","*.jpg","*.png","*.iso"}
For Each foundFile In My.Computer.FileSystem.GetFiles(sourceDir, _
Microsoft.VisualBasic.FileIO.SearchOption.SearchTopLevelOnly, arr)
My.Computer.FileSystem.CopyFile(foundFile, graphicsFldr & My.Computer.FileSystem.GetName(foundFile))
Next

VB.Net Dictionary inside of a dictionary adding / removing data

I'm creating an application where I have different libraries, books and non-book media stored in dictionaries and displayed in listboxes. The user can add and remove additional dictionaries for any of these 3 elements. My issue lies in bringing up the new form to create a link between a library and it's media.
I have a listbox for "Books at Current library" and "Non-Book Media at Current Library" Which will display the media that is linked to the specific library that is highlighted in the listbox. And the user can freely add and remove different media to the library.
frmManager: https://prnt.sc/mnd8qf
frmAssociationScreen: https://prnt.sc/mnd8sh
I'm trying to create a dictionary within a dictionary that I can manipulate the data with for adding the different media to the individual libraries. But I'm unsure where to go from here, I'd like to start by hard coding a few links to Zahnow Library and add a few books as well as one non-book media.
Public Class frmManager
' Global data structures
Public Libraries As New Dictionary(Of String, String)
Public Books As New Dictionary(Of String, String)
Public nonBookMedia As New Dictionary(Of String, String)
Public EquippedLibrary As New Dictionary(Of String, LibraryWithMedia)
Structure LibraryWithMedia
Dim strLibraryName As String
Dim dicBooks As Dictionary(Of String, String)
Dim nonBookMedia As Dictionary(Of String, String)
End Structure
Private Sub frmManager_Load(sender As Object, e As EventArgs) Handles Me.Load
Libraries.Add("SVSU", "Zahnow Library")
Libraries.Add("BR", "Fleschner Memorial Library")
Libraries.Add("SDJ", "Scott D. James Technical Repository")
Books.Add("104", "Data Structures for Fun and Profit")
Books.Add("103", "Doing More With Less - Naval Lint Art")
Books.Add("102", "Interpretive Klingon Poetry")
Books.Add("105", "Programming with the Bidgoli")
Books.Add("101", "Zen and the Art of Appliance Wiring")
nonBookMedia.Add("201", "CD - IEEE Computer: the Hits")
nonBookMedia.Add("203", "DVD - Databases and You: the Video Experience")
nonBookMedia.Add("202", "DVD - The Pirates of Silicon Valley")
populatelstLibrary()
populatelstBooks()
populatelstBookMedia()
End Sub
Sub populatelstLibrary()
lstLibraries.Items.Clear()
For Each library In Libraries
lstLibraries.Items.Add(library.Value & " --- " & library.Key)
Next
End Sub
How I manipulated the data to delete library dictionary
Private Sub btnDeleteLibrary_Click(sender As Object, e As EventArgs) Handles btnDeleteLibrary.Click
Dim key As String = ""
Dim tmpLibraries As New Dictionary(Of String, String)
' If an index is selected in listbox then continue
' If nothing selected, the button does nothing
If lstLibraries.SelectedIndex > -1 Then
If MsgBox("Are you sure you want to delete this library?", MsgBoxStyle.YesNoCancel, "Delete confirmation") = MsgBoxResult.Yes Then
For Each library In Libraries
If lstLibraries.SelectedItem.Equals(library.Value & " --- " & library.Key) Then
' DoNothing
' the selected item is not added to temp library
Else
' Add all other values to temp library
tmpLibraries.Add(library.Key, library.Value)
End If
Next
lstLibraries.Items.Clear() ' Clear the list box
Libraries = tmpLibraries ' Set dictionary Libraries equal to temp libararies
tmpLibraries = Nothing ' Set temp library back to nothing
populatelstLibrary() ' Repopulate the list box
End If
End If
End Sub
frmAssociationScreen.vb
Public Class frmAssociationScreen
Private Sub frmAssociationScreen_Load(sender As Object, e As EventArgs) Handles Me.Load
lstAllLibraries.Items.Clear()
For Each library In frmManager.Libraries
lstAllLibraries.Items.Add(library.Value & " --- " & library.Key)
Next
For Each book In frmManager.Books
lstAllBooks.Items.Add(book.Value & " --- " & book.Key)
Next
For Each nonBook In frmManager.nonBookMedia
lstAllMedia.Items.Add(nonBook.Value & " --- " & nonBook.Key)
Next
End Sub
Private Sub btnManagerScreen_Click(sender As Object, e As EventArgs) Handles btnManagerScreen.Click
Me.Close() ' Close current form
frmManager.Visible = True ' Make manager form visible
End Sub
Private Sub btnAddBook_Click(sender As Object, e As EventArgs) Handles btnAddBook.Click
End Sub
Private Sub btnRemoveBook_Click(sender As Object, e As EventArgs) Handles btnRemoveBook.Click
End Sub
Private Sub lstAllLibraries_SelectedIndexChanged(sender As Object, e As EventArgs) Handles lstAllLibraries.SelectedIndexChanged
End Sub
End Class
Some slight changes in your code as below:
In your structure LibraryWithMedia
We added SUB NEW
' Structure of single library
Structure LibraryWithMedia
'
Dim strLibraryName As String
Dim dicBooks As Dictionary(Of String, String)
Dim nonBookMedia As Dictionary(Of String, String)
'
'new library constructor
Sub New(ByVal LibName As String)
strLibraryName = LibName
dicBooks = New Dictionary(Of String, String)
nonBookMedia = New Dictionary(Of String, String)
End Sub
'
End Structure
In your EquippedLibrary declaration.
The declaration changed from (string, string) to simply LibraryWithMedia
Public EquippedLibrary As List(Of LibraryWithMedia)
At the end/bottom of your Form_Load event
' construct equipped library and define the library names
EquippedLibrary = New List(Of LibraryWithMedia)
' initialise each library with empty books/media dictionaries
populateEquippedLibNames
The PopulateEquippedLibNames Subroutines (this is a new subroutine)
Sub populateEquippedLibNames()
'
Dim Counta As Integer
Dim tmpSingleLib As LibraryWithMedia
'
For Counta = 0 To Libraries.Count - 1
tmpSingleLib = New LibraryWithMedia(Libraries.Values(Counta))
EquippedLibrary.Add(tmpSingleLib)
tmpSingleLib = Nothing
Next
'
End Sub
And then for adding/removing each book to the SELECTED library in the TOP listbox
Private Sub btnAddBook_Click(sender As Object, e As EventArgs) Handles btnAddBook.Click
'
EquippedLibrary(lstLibraries.SelectedIndex).dicBooks.Add(Books.Keys(lstBooks.SelectedIndex), Books.Values(lstBooks.SelectedIndex))
lstSelectedBooks.Items.Add(lstBooks.SelectedItem)
'
End Sub
Private Sub btnRemoveBook_Click(sender As Object, e As EventArgs) Handles btnRemoveBook.Click
'
EquippedLibrary(lstLibraries.SelectedIndex).dicBooks.Remove(Books.Keys(lstBooks.SelectedIndex))
'
End Sub
Note that to add a book/media to a library,
A library MUST BE selected in the TOP listbox
The Book or Media being added must also be selected
No error checking is performed, so you will need to add it (such as a listbox has a selection or not) etc
Update
I have added the libraries on change code for you below
Private Sub lstLibraries_SelectedIndexChanged(sender As Object, e As EventArgs) Handles lstLibraries.SelectedIndexChanged
'
Dim Counta As Integer
'
lstSelectedBooks.Items.Clear()
lstSelectedMedia.Items.Clear()
If EquippedLibrary(lstLibraries.SelectedIndex).dicBooks.Count > 0 Then
For Counta = 0 To EquippedLibrary(lstLibraries.SelectedIndex).dicBooks.Count - 1
lstSelectedBooks.Items.Add(EquippedLibrary(lstLibraries.SelectedIndex).dicBooks.Keys(Counta) & " --- " & EquippedLibrary(lstLibraries.SelectedIndex).dicBooks.Values(Counta))
Next
End If
Counta = Nothing
'
End Sub

Problems with splitt out SIP-Address from AppData\Local\Microsoft\Office\16.0\Lync

I'm trying to split out the sip_address in folder C:\Users\%username%\AppData\Local\Microsoft\Office\16.0\Lync Since I have more than one active SIP-addresses I have some problems getting the one I need in this example it would be example2#example2.com
There might also be more SIP-addresses in this folder, but I would only like to have the one example2.
I started with sorting out all subfolder in directory giving me a result:
C:\Users\%username%\AppData\Local\Microsoft\Office\16.0\Lync\sip_example1#example1.com
C:\Users\%username%\AppData\Local\Microsoft\Office\16.0\Lync\sip_example2#example2.com
C:\Users\c%username%\AppData\Local\Microsoft\Office\16.0\Lync\Tracing
And here is where face issues with splitting as my code are not good at all and the result would be:
example2#example2.comC:\Users\%username%\AppData\Local\Microsoft\Office\16.0\Lync\Tracing
Imports System.IO
Public Class Form1
Dim SIPAccount As String
Private Sub GETSipAccount()
' Path and SIP-Addresses has been anonymous due to personal addresses.
For Each Dir As String In Directory.GetDirectories("C:\Users\%username%\AppData\Local\Microsoft\Office\16.0\Lync")
' List out directory
SIPAccount = SIPAccount & Dir & vbNewLine
On Error Resume Next ' I do not want to include this in my application at all
' Splits out text
SIPAccount = ((Split(Split(SIPAccount, "sip_")(1), "#example2.com")(0))) & "#example2.com"
MsgBox(SIPAccount)
Next
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
GETSipAccount()
End Sub
depending if the "example2" string part is unique to the directory address you could use something like
Dim lst As List(Of String) = IO.Directory.GetDirectories("C:...").ToList
MessageBox.Show(lst.FindAll(Function(x) x.Contains("example2"))(0))
if you want to compare just the last part of the string you could use something like
Dim lst As List(Of String) = IO.Directory.GetDirectories("C:...").ToList
For Each item As String In lst
Dim lastindexofbackslash As Integer = item.LastIndexOf("\")
Dim _item As String = item.Substring(lastindexofbackslash + 1)
If _item.Contains("example2") Then
MsgBox(_item.Substring(4))
End If
Next

Multiple Search Criteria (VB.NET)

So my problem is:
I have a List of a custom Type {Id as Integer, Tag() as String},
and i want to perform a multiple-criteria search on it; eg:
SearchTags={"Document","HelloWorld"}
Results of the Search will be placed a ListBox (ListBox1) in this format:
resultItem.id & " - " & resultItem.tags
I already tried everything i could find on forums, but it didn't work for me (It was for db's or for string datatypes)
Now, i really need your help. Thanks in advance.
For Each MEntry As EntryType In MainList
For Each Entry In MEntry.getTags
For Each item As String In Split(TextBox1.Text, " ")
If Entry.Contains(item) Then
If TestIfItemExistsInListBox2(item) = False Then
ListBox1.Items.Add(item & " - " & Entry.getId)
End If
End If
Next
Next
Next
Example Custom Array:
(24,{"snippet","vb"})
(32,{"console","cpp","helloworld"})
and so on...
I searched for ("Snippet vb test"):
snippet vb helloWorld - 2
snippet vb tcpchatEx - 16
cs something
test
So, i'll get everything that contains one of my search phrases.
I expected following:
snippet vb tcp test
snippet vb dll test
snippet vb test metroui
So, i want to get everything that contains all my search phrases.
My entire, code-likely class
Imports Newtonsoft.Json
Public Class Form2
Private Sub Form2_Load(sender As Object, e As EventArgs) Handles MyBase.Load
End Sub
Dim MainList As New List(Of EntryType)
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
MainList.Clear()
Dim thr As New Threading.Thread(AddressOf thr1)
thr.SetApartmentState(Threading.ApartmentState.MTA)
thr.Start()
End Sub
Delegate Sub SetTextCallback([text] As String)
Private Sub SetTitle(ByVal [text] As String) ' source <> mine
If Me.TextBox1.InvokeRequired Then
Dim d As New SetTextCallback(AddressOf SetTitle)
Me.Invoke(d, New Object() {[text]})
Else
Me.Text = [text]
End If
End Sub
Sub thr1()
Dim linez As Integer = 1
Dim linex As Integer = 1
For Each line As String In System.IO.File.ReadAllLines("index.db")
linez += 1
Next
For Each line As String In System.IO.File.ReadAllLines("index.db")
Try
Application.DoEvents()
Dim a As saLoginResponse = JsonConvert.DeserializeObject(Of saLoginResponse)(line) ' source <> mine
Application.DoEvents()
MainList.Add(New EntryType(a.id, Split(a.tags, " ")))
linex += 1
SetTitle("Search (loading, " & linex & " of " & linez & ")")
Catch ex As Exception
End Try
Next
SetTitle("Search")
End Sub
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
Dim searchTags() As String = TextBox1.Text.Split(" ")
Dim query = MainList.Where(Function(et) et.Tags.Any(Function(tag) searchTags.Contains(tag))).ToList
For Each et In query
ListBox1.Items.Add(et.Id)
Next
End Sub
Private Sub Button4_Click(sender As Object, e As EventArgs) ' test
MsgBox(Mid(ListBox1.SelectedItem.ToString, 1, 6)) ' test
End Sub 'test, removeonrelease
End Class
Public Class EntryType
Public Property Id As Integer
Public Property Tags() As String
Public Sub New(ByVal _id As Integer, ByVal _tags() As String)
Me.Id = Id
Me.Tags = Tags
End Sub
Public Function GetTags() As String
'to tell the Listbox what to display
Return Tags
End Function
Public Function GetId() As Integer
'to tell the Listbox what to display
Return Id
End Function
End Class
I also edited your EntryType class; I added a constructor, removed toString and added GetTags and GetID.
Example "DB" im working with ("db" as "index.db" in exec dir):
{"tags":"vb.net lol test qwikscopeZ","id":123456}
{"tags":"vb.net lol test","id":12345}
{"tags":"vb.net lol","id":1234}
{"tags":"vb.net","id":123}
{"tags":"cpp","id":1}
{"tags":"cpp graphical","id":2}
{"tags":"cpp graphical fractals","id":3}
{"tags":"cpp graphical fractals m4th","id":500123}
Error:
Debugger:Exception Intercepted: _Lambda$__1, Form2.vb line 44
An exception was intercepted and the call stack unwound to the point before the call from user code where the exception occurred. "Unwind the call stack on unhandled exceptions" is selected in the debugger options.
Time: 13.11.2014 03:46:10
Thread:<No Name>[5856]
Here is a Lambda query. The Where filters on a predicate, since Tags is an Array you can use the Any function to perform a search based on another Array-SearchTags. You can store each class object in the Listbox since it stores Objects, you just need to tell it what to display(see below).
Public Class EntryType
Public Property Id As Integer
Public Property Tags() As As String
Public Overrides Function ToString() As String
'to tell the Listbox what to display
Return String.Format("{0} - {1}", Me.Id, String.Join(Me.Tags, " "))
End Function
End Class
Dim searchTags = textbox1.Text.Split(" "c)
Dim query = mainlist.Where(Function(et) et.Tags.Any(Function(tag) searchTags.Contains(tag))).ToList
For Each et In query
Listbox1.Items.Add(et)
Next

vb.net autocad 2007 selection set has no Items

In OS WIn 7 using Autocad 2007 I try to select items then do stuff
Problem is that there are no ITEMS in the selection set ssetObj - not sure why!
Code: works in vba but not standalone vb.net
Private Sub CommandButton1_Click()
Dim myapp As AcadApplication
Dim mydoc As AcadDocument
Dim ssetObj As AcadSelectionSet
Dim ent As AcadObject
Dim numVertices As Long
On Error GoTo err:
Set myapp = GetObject(, "AutoCAD.Application.17")
Set mydoc = myapp.ActiveDocument
If mydoc.SelectionSets.Count > 0 Then
mydoc.SelectionSets(0).Delete
End If
Set ssetObj = mydoc.SelectionSets.Add("ss")
list1.Clear
Me.Hide
AppActivate ("Autocad")
ssetObj.SelectOnScreen:'WORKS TO SELECT
Dim numpls As Integer
numpls = ssetObj.Count:'WORKS TO GET COUNT
Dim i As Integer
For i = 0 To numpls - 1
Set ent = ssetObj.Item(i)':PROBLEM HERE**THERE ARE NO ITEMS THOUGH COUNT IS CORRECT
If ent.ObjectName = "AcDbLWPolyline" Or ent.ObjectName = "AcDbPolyline" Then
numVertices = (UBound(ent.Coordinates) + 1) / 2
list1.AddItem Str(ent.ObjectID) + "\" + Str(numVertices) + " Vertices"
End If
Next i
Me.Show
Exit Sub
err:
MsgBox err.Description
End Sub
Edit: Further investigation shows that you should be calling ssetObj(i) if you want to get indexed items of your selection set.
I'd not worry about trying to get the count of the selection set anyway if you plan on iterating through it. A For Each should suffice to walk though it. One of the problems with going from VBA/VB6 to VB.NET is the temptation to use the same methodology, when it can sometimes be invalid (at times it can be excellent, but .NET is very capable). Here's my entire class that I tested your problem with, just to show how I'm connecting to AutoCAD and interfacing with it.
Public Class frmMain
Private acApp As AcadApplication
Private polyList As List(Of String)
Const acProgId As String = "AutoCAD.Application.17"
<DllImport("User32.dll")> _
Private Shared Function SetForegroundWindow(ByVal hWnd As IntPtr) As Boolean
End Function
Private Sub btnStart_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnStart.Click
Try
acApp = DirectCast(Marshal.GetActiveObject(acProgId), AcadApplication)
Catch
Try
Dim acType = Type.GetTypeFromProgID(acProgId)
acApp = DirectCast(Activator.CreateInstance(acType), AcadApplication)
Catch ex As Exception
MsgBox("Unable to create AutoCAD application of type: " & acProgId)
End Try
End Try
End Sub
Private Sub btnSelect_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnSelect.Click
If acApp Is Nothing Then Return
acApp.Visible = True
Dim acDoc As AcadDocument = acApp.ActiveDocument
' Kill all existing selection sets
While (acDoc.SelectionSets.Count > 0)
acDoc.SelectionSets(0).Delete()
End While
Dim mySS As AcadSelectionSet = acDoc.SelectionSets.Add("ss")
SetForegroundWindow(acApp.HWND)
mySS.SelectOnScreen()
polyList = New List(Of String)
Dim numVertices As Integer
For Each ent As AcadEntity In mySS
If ent.ObjectName = "AcDbLWPolyline" Or
ent.ObjectName = "AcDbPolyline" Then
numVertices = (ent.Coordinates.Length) / 2
polyList.Add(String.Format("{0} \ {1} Vertices", ent.ObjectID, numVertices))
End If
Next
End Sub
End Class
External COM methods like this are going to be slower than you're used to seeing via VBA. Therefore it's definitely worth diving into the in-process AutoCAD .NET stuff to see great performance.