Maybe a simple question, but I am just getting into this dot net stuff
so.......
does anyone have a sample on how best to step through a selection set.
I need to extract the Text properties of each of the text objects in the selection set
this is all I have so far
Private Sub ExtractText(ByRef acSSet As SelectionSet) '' Step through the objects in the selection set For Each acSSObj As SelectedObject In acSSet Dim acEnt As Entity = GetObject..?????? '' Write data to MDB file. Next End Sub
thanks in advance.
try this
To get the entity use (in C#)
Entity acEnt = (Entity)tr.GetObject(acSSObj.ObjectId, OpenMode.ForRead);
You can try this code as well
' Imports System.Collections.Specialized Private Function ExtractText() As StringCollection Dim txtcoll As New StringCollection Dim doc As Document = Application.DocumentManager.MdiActiveDocument() Dim db As Database = doc.Database Dim ed As Editor = doc.Editor Try Using tr As Transaction = db.TransactionManager.StartTransaction Dim res As PromptSelectionResult Dim filterList(,) As Object = New Object(,) {{-4, "<or"}, {0, "text"}, {0, "mtext"}, {-4, "or>"}} '' etc Dim tvs(filterList.GetUpperBound(0)) As TypedValue For i As Integer = 0 To filterList.GetUpperBound(0) tvs(i) = New TypedValue(Convert.ToInt32(filterList(i, 0)), filterList(i, 1)) Next Dim filt As SelectionFilter = New SelectionFilter(tvs) res = ed.SelectAll(filt) If res.Status <> PromptStatus.OK Then Return Nothing End If For Each sobj As SelectedObject In res.Value Dim ent As Entity = tr.GetObject(sobj.ObjectId, OpenMode.ForRead) Dim txt As DBText = TryCast(ent, DBText) If txt IsNot Nothing Then txtcoll.Add(txt.TextString) End If Dim mtxt As MText = TryCast(ent, MText) If mtxt IsNot Nothing Then txtcoll.Add(mtxt.Contents) End If Next End Using Catch exs As System.Exception ed.WriteMessage(exs.Message & vbLf & exs.StackTrace) Return Nothing Finally End Try Return txtcoll End Function Public Sub TestTexts() Dim txtcoll As StringCollection = ExtractText() Dim tb As System.Data.DataTable = New System.Data.DataTable tb.Columns.Add("text") For Each str As String In txtcoll Dim dr As System.Data.DataRow = tb.NewRow dr(0) = str tb.Rows.Add(dr) Next '' pull this datatable in MDB here End Sub
~'J'~
I found it very hard going from VBA to VB.Net. Keep sticking with it, and you will find it gets easier exponentially. The hardest bit for me was all of the extra stuff you needed to do (Start transactions, table records etc)
Hallex thanks you for your help.
If I may, I have another question.
In your code I see that you create a collection of the extracted text.
You then created a sub to create a data table that will be used to populate a MDB file. (not sure how)
In terms of programming practice, is there a reason why you choose this path instead of writing the text directly to the MDB file within the function ExtractText() in the For Each sobj , loop?
I have been searching, with no success on how to write to MDB file,
After I create a new MDB and a table I have the following to try and write to the table. but I am not sure if it is the proper way to do this. Additionally how do you write variable data?
i.e. TxtStr=”Hello”
PtX=1.0
PtY=1.0
Any suggestion or improvements.
Dim ADOXcatalog As New ADOX.Catalog Dim ADOXtable As New ADOX.Table Dim con As ADODB.Connection On Error Resume Next ADOXcatalog.ActiveConnection = _ "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" _ & "c:\newdata.mdb" con = ADOXcatalog.ActiveConnection ' Insert records. con.Execute("INSERT INTO TextDB VALUES (‘Hello’, " & _ "'1.00', '1.00')") con.Execute("INSERT INTO TextDB VALUES ('Test', " & _ "'3.00', '3.00')") ' Close the database connection. con.Close() con = Nothing
See if this is working for you
I tested them on A2009 only
Imports ADOX Imports System.Data Imports System.Collections.Specialized Imports Autodesk.AutoCAD.ApplicationServices Imports Autodesk.AutoCAD.DatabaseServices Imports Autodesk.AutoCAD.Runtime Imports Autodesk.AutoCAD.EditorInput Imports System.Data.OleDb <CommandMethod("TestAdox")> _ Public Sub TestTexts() Dim txtcoll As StringCollection = ExtractText() Dim tb As System.Data.DataTable = New System.Data.DataTable tb.Columns.Add("text") For Each str As String In txtcoll Dim dr As System.Data.DataRow = tb.NewRow dr(0) = str tb.Rows.Add(dr) Next '' pull this datatable in MDB here InsertText(tb) End Sub Private Function ExtractText() As StringCollection Dim txtcoll As New StringCollection Dim doc As Document = Application.DocumentManager.MdiActiveDocument() Dim db As Database = doc.Database Dim ed As Editor = doc.Editor Try Using tr As Transaction = db.TransactionManager.StartTransaction Dim res As PromptSelectionResult Dim filterList(,) As Object = New Object(,) {{-4, "<or"}, {0, "text"}, {0, "mtext"}, {-4, "or>"}} '' etc Dim tvs(filterList.GetUpperBound(0)) As TypedValue For i As Integer = 0 To filterList.GetUpperBound(0) tvs(i) = New TypedValue(Convert.ToInt32(filterList(i, 0)), filterList(i, 1)) Next Dim filt As SelectionFilter = New SelectionFilter(tvs) res = ed.SelectAll(filt) If res.Status <> PromptStatus.OK Then Return Nothing End If For Each sobj As SelectedObject In res.Value Dim ent As Entity = tr.GetObject(sobj.ObjectId, OpenMode.ForRead) Dim txt As DBText = TryCast(ent, DBText) If txt IsNot Nothing Then txtcoll.Add(txt.TextString) End If Dim mtxt As MText = TryCast(ent, MText) If mtxt IsNot Nothing Then txtcoll.Add(mtxt.Contents) End If Next End Using Catch exs As System.Exception ed.WriteMessage(exs.Message & vbLf & exs.StackTrace) Return Nothing Finally End Try Return txtcoll End Function Public Sub InsertText(dt As System.Data.DataTable) Try Dim OleConn As New OleDbConnection Dim OleDa As OleDbDataAdapter = New OleDbDataAdapter() Dim OleSb As New OleDbConnectionStringBuilder() OleSb.DataSource = "c:\Test\tmp.mdb" '<-- change path here OleSb.Provider = "Microsoft.Jet.OLEDB.4.0" OleSb.PersistSecurityInfo = False OleConn = New OleDbConnection(OleSb.ConnectionString) OleConn.Open() Dim strSQL As String = "select BlockName from Blocks" '<-- change string here OleDa.SelectCommand = New OleDbCommand(strSQL, OleConn) strSQL = "insert into Blocks (BlockName) values (@BlockName)" '<-- change string here OleDa.InsertCommand = New OleDbCommand(strSQL, OleConn) OleDa.InsertCommand.Parameters.Add("@BlockName", OleDbType.VarChar, 20, "BlockName") '<-- change string here For Each dr As System.Data.DataRow In dt.Rows Dim txt As String = Convert.ToString(dr(0)) OleDa.InsertCommand.Parameters("@BlockName").Value = txt '<-- change string here OleDa.InsertCommand.ExecuteNonQuery() Next OleConn.Close() Catch ex As Exception MsgBox(ex.Message & vbLf & ex.StackTrace) End Try End Sub
~'J'~
I not sure if I should create a new post on this but here goes.
I am attempting to write data to a recordset as per the MSDN site.
recordset.AddNew FieldList, Values
recordset: A Recordset object. FieldList: Optional. A single name, or an array of names or ordinal positions of the fields in the new record.
Values
Optional. A single value, or an array of values for the fields in the new record. If Fieldlist is an array, Values must also be an array with the same number of members; otherwise, an error occurs. The order of field names must match the order of field values in each array.
However I get an error. COMException was unhandled by user code.{"Arguments are of the wrong type, are out of acceptable range, or are in conflict with one another."
any ideas or suggestions.
Private Sub Addrecord() Dim catDB As ADOX.Catalog Dim strDBPath As String = "c:\newdata.mdb" Dim strTbl As String = "Annotation" catDB = New ADOX.Catalog ' Open the catalog. Dim cnn As New ADODB.Connection cnn.Open("Provider='Microsoft.Jet.OLEDB.4.0';" & _ "Data Source= '" & strDBPath & "';") catDB.ActiveConnection = cnn Dim rs = New ADODB.Recordset rs.Open(strTbl, cnn, CursorTypeEnum.adOpenKeyset, LockTypeEnum.adLockOptimistic) 'adOpenKeyset, adLockOptimistic, adCmdTable) Dim fieldsArray(6) As String fieldsArray(0) = "ADMAPKEY" fieldsArray(1) = "LotKey" fieldsArray(2) = "X1" fieldsArray(3) = "Y1" fieldsArray(4) = "TEXT_ANGLE" fieldsArray(5) = "TEXT_SIZE" fieldsArray(6) = "TEXTSTRING" Dim values(6) As Object values(0) = "Hello" values(1) = 1111 values(2) = 2222 values(3) = 33333 values(4) = 4444 values(5) = 5555 values(6) = "TEST" rs.AddNew(fieldsArray, values) 'rs.AddNew() 'rs.Fields.Item("ADMAPKEY").Value = "Hello" 'rs.Fields.Item("LotKey").Value = 222 'rs.Fields.Item("X1").Value = 123 'rs.Fields.Item("Y1").Value = 456 'rs.Fields.Item("TEXT_ANGLE").Value = 789 'rs.Fields.Item("TEXT_SIZE").Value = 234 'rs.Fields.Item("TEXTSTRING").Value = "Hello" 'rs.AddNew() rs.Update() rs.Close() rs = Nothing End Sub
Hi,
Sorry for interrupt, but just to make sure: If you are running on 64bit OS (and so 64bit AutoCAD) you will not be able to use the "Microsoft.Jet" driver as it is limited to 32bit.
I think MDB-files are no files for future use as Microsoft is pushing SQLServer (and keeps on blocking everything else).
If you do now start a development think about SQL-Server Express (which is free) or I use very often SQLite (also free plus the biggest advantage: it's file based, you don't need any additional installation for using it).
- alfred -
Hello afred
Thanks for the tip.
I am running Map as well as office in 32bit.
Unfortunately I am stuck with this for now.
It would be great if Autodesk and MS played nice, for the most part I guess they do.
The struggle is finding the latest samples out there, as API change from one version to the next.
OK....sigh!!!!
my DUM mistake.
I was pushing a string into a field that is numeric.
all the same it seem that the following works better.
rs.AddNew() rs.Fields.Item("ADMAPKEY").Value = 123 rs.Fields.Item("LotKey").Value = "Hello" rs.Fields.Item("X1").Value = 123 rs.Fields.Item("Y1").Value = 456 rs.Fields.Item("TEXT_ANGLE").Value = 789 rs.Fields.Item("TEXT_SIZE").Value = 234 rs.Fields.Item("TEXTSTRING").Value = "Text"
Can't find what you're looking for? Ask the community or share your knowledge.