The below code is one part of code which am using now and i got this solutions here only. Now comming to problem: i am trying my best for select all from screen without opening AutoCAD but they are not successful.
Can any one alter this piece of code so that it will select all without opening CAD
Regards
Amit
Public Shared Sub ReadTexts()
Dim acadver As String = "18" '//AutoCAD Version
' Set your file name to read data here
'Dim fname As String = "C:\Test\tags.dwg"
' Define csv file name variable
Dim csvname As String = String.Empty
Dim listData As New List(Of Object)
' Get current culture
Dim oldCult As System.Globalization.CultureInfo = System.Threading.Thread.CurrentThread.CurrentCulture
' Create new culture
Dim thisCult As System.Globalization.CultureInfo = New System.Globalization.CultureInfo("en-US")
' Set current culture to newly created
System.Threading.Thread.CurrentThread.CurrentCulture = thisCult
MsgBox("Wait...")
Dim appProgID As String = "Autocad.Application" + "." + acadver
' Get reference on interface IDispatch
Dim AcadType As Type = Type.GetTypeFromProgID(appProgID)
' Run AutoCAD
Dim AcadApp As Object = Activator.CreateInstance(AcadType)
Dim visargs() As Object = New Object(0) {}
' Set visibility mode to true
visargs(0) = False
' Make application visible
AcadApp.GetType().InvokeMember("Visible", BindingFlags.SetProperty, Nothing, AcadApp, visargs, Nothing)
' Maximize window
AcadApp.GetType().InvokeMember("WindowState", BindingFlags.SetProperty, Nothing, AcadApp, New Object() {1}, Nothing)
Dim AcadDocs As Object = AcadApp.GetType().InvokeMember("Documents", BindingFlags.GetProperty, Nothing, AcadApp, Nothing)
' Define arguments to open file
Dim args() As Object = New Object(1) {}
args(0) = fname
' Set read only mode to true
args(1) = False
' Try open document
Dim AcDoc As Object = AcadDocs.GetType.InvokeMember("Open", BindingFlags.InvokeMethod, Nothing, AcadDocs, args, Nothing)
Dim AcUtil As Object = New Object
Try
' get reference on active document
AcDoc = AcadApp.GetType.InvokeMember("ActiveDocument", BindingFlags.GetProperty, Nothing, AcadApp, Nothing, Nothing)
' Get reference on ModelSpace
Dim AcSpace As Object = AcDoc.GetType.InvokeMember("ModelSpace", BindingFlags.GetProperty, Nothing, AcDoc, Nothing)
' get reference on Utility
AcUtil = AcDoc.GetType.InvokeMember("Utility", BindingFlags.GetProperty, Nothing, AcDoc, Nothing, Nothing)
' get reference on SelectionSets
Dim AcSsets As Object = AcDoc.GetType.InvokeMember("SelectionSets", BindingFlags.GetProperty, Nothing, AcDoc, Nothing, Nothing)
' Perform zooming
AcadApp.GetType.InvokeMember("ZoomExtents", BindingFlags.InvokeMethod, Nothing, AcadApp, Nothing, Nothing)
' Perform zooming
AcadApp.GetType.InvokeMember("ZoomScaled", BindingFlags.InvokeMethod, Nothing, AcadApp, New Object() {0.8, 1})
' Add prompt to the command line
'AcUtil.GetType.InvokeMember("Prompt", BindingFlags.InvokeMethod, Nothing, AcUtil, New Object() {vbLf & " >> SELECT TEXTS ON SCREEN >> "})
' Add SelectionSet, named "$SelectionTest$"
AcSsets.GetType.InvokeMember("Add", BindingFlags.InvokeMethod, Nothing, AcSsets, New Object() {"$SelectionTest$"})
' Get reference on newly created Selection Set
Dim AcSset As Object = AcSsets.GetType.InvokeMember("Item", BindingFlags.InvokeMethod Or BindingFlags.GetProperty, Nothing, AcSsets, New Object() {"$SelectionTest$"})
' Create filter to use attributed blocks
Dim selargs As Object() = New Object(1) {}
Dim ftype As Short() = New Short() {0}
Dim fdata As Object() = New Object() {"*TEXT"}
selargs(0) = DirectCast(ftype, Object)
selargs(1) = DirectCast(fdata, Object)
' Perform selection on screen
'AcSset.GetType.InvokeMember("SelectOnScreen", BindingFlags.InvokeMethod, Nothing, AcSset, selargs)
' Get number of selected items
Dim cnt As Integer = CInt(AcSset.GetType.InvokeMember("Count", BindingFlags.GetProperty, Nothing, AcSset, Nothing))
' Add prompt to the command line
AcUtil.GetType.InvokeMember("Prompt", BindingFlags.InvokeMethod, Nothing, AcUtil, New Object() {vbLf & "--> Selected Mtexts -->" & vbTab & cnt.ToString()})
' Loop through selected objects
For n As Integer = 0 To cnt - 1
' Get single item from selection
Dim AcSelItem As Object = AcSset.GetType.InvokeMember("Item", BindingFlags.InvokeMethod, Nothing, AcSset, New Object() {n})
' Get Object name
Dim objName As String = AcSelItem.GetType.InvokeMember("ObjectName", BindingFlags.GetProperty, Nothing, AcSelItem, Nothing).ToString()
Dim textStr As String = String.Empty
If objName = "AcDbText" Then
textStr = AcSelItem.GetType.InvokeMember("TextString", BindingFlags.GetProperty, Nothing, AcSelItem, Nothing).ToString()
ElseIf objName = "AcDbMText" Then
textStr = AcSelItem.GetType.InvokeMember("TextString", BindingFlags.GetProperty, Nothing, AcSelItem, Nothing).ToString()
End If
listData.Add(textStr)
Next
Dim initDir As String = AcDoc.GetType.InvokeMember("Path", BindingFlags.GetProperty, Nothing, AcDoc, Nothing, Nothing).ToString()
Dim saveFileDialog As New System.Windows.Forms.SaveFileDialog
saveFileDialog.Title = "Enter a file name to write data: "
saveFileDialog.InitialDirectory = initDir
saveFileDialog.RestoreDirectory = True
saveFileDialog.Filter = "CSV files | *.csv"
saveFileDialog.FileName = "File name without extension"
Dim result As System.Windows.Forms.DialogResult = saveFileDialog.ShowDialog()
If result <> DialogResult.OK Then
csvname = "Not saved"
Return
End If
csvname = saveFileDialog.FileName
' Write data
Using sw As New StreamWriter(csvname, True, Encoding.ASCII)
For Each strline As String In listData
sw.WriteLine(strline)
Next
sw.Flush()
sw.Close()
End Using
'Save document
Dim closeargs() As Object = New Object(1) {}
closeargs(0) = True
' with the same name
closeargs(1) = fname
' Try close document
' Simplified syntax
AcDoc.GetType().InvokeMember("Close", BindingFlags.InvokeMethod, Nothing, AcDoc, closeargs)
' Try quit application
AcadApp.GetType().InvokeMember("Quit", BindingFlags.InvokeMethod, Nothing, AcadApp, Nothing)
Catch ex As System.Exception
MsgBox("Error: " & ex.Message & vbLf & "Trace: " & ex.StackTrace)
Finally
' clean up the memory
'--------------------'
' release Utility.
releaseObject(AcUtil)
' release Document.
releaseObject(AcDoc)
' release Documents.
releaseObject(AcadDocs)
' release Application.
releaseObject(AcadApp)
' call garbage cleaner immediatelly
GC.WaitForPendingFinalizers()
GC.GetTotalMemory(True)
GC.WaitForPendingFinalizers()
GC.GetTotalMemory(True)
' restore current culture
System.Threading.Thread.CurrentThread.CurrentUICulture = oldCult
'Display result
MsgBox("Csv file saved as : " + csvname)
End Try
End Sub
Solved! Go to Solution.
Solved by Hallex. Go to Solution.
Try another one
Public Shared Sub ReadTextFromModel() Dim acadver As String = "18" '//AutoCAD Version ' Set your file name to read data here Dim fname As String = "C:\Test\tags.dwg" ' Define csv file name variable Dim csvname As String = String.Empty Dim listData As New List(Of Object) ' Get current culture Dim oldCult As System.Globalization.CultureInfo = System.Threading.Thread.CurrentThread.CurrentCulture ' Create new culture Dim thisCult As System.Globalization.CultureInfo = New System.Globalization.CultureInfo("en-US") ' Set current culture to newly created System.Threading.Thread.CurrentThread.CurrentCulture = thisCult MsgBox("Wait...") Dim appProgID As String = "Autocad.Application" + "." + acadver ' Get reference on interface IDispatch Dim AcadType As Type = Type.GetTypeFromProgID(appProgID) ' Run AutoCAD Dim AcadApp As Object = Activator.CreateInstance(AcadType) Dim visargs() As Object = New Object(0) {} ' Set visibility mode to false visargs(0) = False ' Make application visible AcadApp.GetType().InvokeMember("Visible", BindingFlags.SetProperty, Nothing, AcadApp, visargs, Nothing) ' Maximize window ''AcadApp.GetType().InvokeMember("WindowState", BindingFlags.SetProperty, Nothing, AcadApp, New Object() {1}, Nothing) Dim AcadDocs As Object = AcadApp.GetType().InvokeMember("Documents", BindingFlags.GetProperty, Nothing, AcadApp, Nothing) ' Define arguments to open file Dim args() As Object = New Object(1) {} args(0) = fname ' Set read only mode to false args(1) = False ' Try open document Dim AcDoc As Object = AcadDocs.GetType.InvokeMember("Open", BindingFlags.InvokeMethod, Nothing, AcadDocs, args, Nothing) Try ' get reference on active document AcDoc = AcadApp.GetType.InvokeMember("ActiveDocument", BindingFlags.GetProperty, Nothing, AcadApp, Nothing, Nothing) ' Get reference on ModelSpace Dim AcSpace As Object = AcDoc.GetType.InvokeMember("ModelSpace", BindingFlags.GetProperty, Nothing, AcDoc, Nothing) Dim entCount As Integer = Convert.ToInt32(AcSpace.GetType.InvokeMember("Count", BindingFlags.GetProperty, Nothing, AcSpace, Nothing)) ' Loop through selected objects For index As Integer = 0 To entCount - 1 ' Get single item from selection Dim AcEnt As Object = AcSpace.GetType.InvokeMember("Item", BindingFlags.InvokeMethod, Nothing, AcSpace, New Object() {index}) ' Get Object name Dim objName As String = AcEnt.GetType.InvokeMember("ObjectName", BindingFlags.GetProperty, Nothing, AcEnt, Nothing).ToString() Dim textStr As String = String.Empty If objName = "AcDbText" Then textStr = AcEnt.GetType.InvokeMember("TextString", BindingFlags.GetProperty, Nothing, AcEnt, Nothing).ToString() ElseIf objName = "AcDbMText" Then textStr = AcEnt.GetType.InvokeMember("TextString", BindingFlags.GetProperty, Nothing, AcEnt, Nothing).ToString() End If listData.Add(textStr) Next Dim initDir As String = AcDoc.GetType.InvokeMember("Path", BindingFlags.GetProperty, Nothing, AcDoc, Nothing, Nothing).ToString() Dim saveFileDialog As New System.Windows.Forms.SaveFileDialog saveFileDialog.Title = "Enter a file name to write data: " saveFileDialog.InitialDirectory = initDir saveFileDialog.RestoreDirectory = True saveFileDialog.Filter = "CSV files | *.csv" saveFileDialog.FileName = "File name without extension" Dim result As System.Windows.Forms.DialogResult = saveFileDialog.ShowDialog() If result <> DialogResult.OK Then csvname = "Not saved" Return End If csvname = saveFileDialog.FileName ' Write data Using sw As New StreamWriter(csvname, True, Encoding.ASCII) For Each strline As String In listData sw.WriteLine(strline) Next sw.Flush() sw.Close() End Using 'Save document Dim closeargs() As Object = New Object(1) {} closeargs(0) = True ' with the same name closeargs(1) = fname ' Try close document ' Simplified syntax AcDoc.GetType().InvokeMember("Close", BindingFlags.InvokeMethod, Nothing, AcDoc, closeargs) ' Try quit application AcadApp.GetType().InvokeMember("Quit", BindingFlags.InvokeMethod, Nothing, AcadApp, Nothing) Catch ex As System.Exception MsgBox("Error: " & ex.Message & vbLf & "Trace: " & ex.StackTrace) Finally ' clean up the memory '--------------------' ' release Document. releaseObject(AcDoc) ' release Documents. releaseObject(AcadDocs) ' release Application. releaseObject(AcadApp) ' call garbage cleaner immediatelly GC.WaitForPendingFinalizers() GC.GetTotalMemory(True) GC.WaitForPendingFinalizers() GC.GetTotalMemory(True) ' restore current culture System.Threading.Thread.CurrentThread.CurrentUICulture = oldCult 'Display result MsgBox("Csv file saved as : " + csvname) End Try End Sub
~'J'~
Oooh, why do you need to do all the late-binding if you specifcally want to run the code against Acad version 18 (2010)? Have you debugged line by line? What is it that you cannot just set reference to Acad type library and have strongly typed variables (so that it is easier to debug)?
If you have to use late-binding for a mystical reason, you 'd better just started with early-binding to make sure your logic works (it looked like you are still not very familar with Acad programming), worked out all potential issues, then convert it to late-binding with all that "InvokeMember/InvokeMethod" calls, which you do not get intellisense prompt for and thus is error-prone process.
Norman Yuan
Perfect, Thankyou Hallex It worked really Great.
Thankyou Hallex for Supporting me.
Thankyou
Regards
Amit
But if i replace TextString by Origins or Points can i get the Starting location/Mid Point of Texts. So that i will write another logic by specifying Points and search in range to get texts
Glad if you got it to work
Cheers
~'J'~
You wrote:
But if i replace TextString by Origins or Points can i get the Starting location/Mid Point of Texts. So that i will write another logic by specifying Points and search in range to get texts
In this case you need to calculate a mid point,
based on "GetBoundingBox" method of
the text
I havent have an example of the code and also
I'm busy on today with my own...
~'J'~
Ok Hallex i will Work on it using GetBoundingBox method of Texts. Thanks for Reply.
With Warm Regards
Amit
Try this code, I've found the code written by great TT,
in the midpoint of text bounds this will draw a blue circles
for imagination:
Imports System.IO Imports System.Text Imports System.Runtime.InteropServices Imports System.Reflection Imports System.Globalization Imports System.Collections
' sample aux Public Shared Function DrawCircle(ByVal oBlock As Object, ByVal p() As Double, ByVal rad As Double) As Object Dim args() As Object = New Object(1) {} args(0) = p args(1) = rad Dim oCirc As Object = oBlock.GetType.InvokeMember("AddCircle", BindingFlags.InvokeMethod, Nothing, oBlock, args) Dim norm() As Double = New Double() {0.0, 0.0, 1.0} oCirc.GetType().InvokeMember("Normal", BindingFlags.SetProperty, Nothing, oCirc, New Object() {norm}) Return oCirc End Function Public Shared Sub ImportTextFromModel() Dim acadver As String = "18" '//AutoCAD Version ' Set your file name to read data here Dim fname As String = "C:\Test\mtext.dwg" ' Define csv file name variable Dim csvname As String = String.Empty Dim listData As New List(Of Object) ' Get current culture Dim oldCult As System.Globalization.CultureInfo = System.Threading.Thread.CurrentThread.CurrentCulture ' Create new culture Dim thisCult As System.Globalization.CultureInfo = New System.Globalization.CultureInfo("en-US") ' Set current culture to newly created System.Threading.Thread.CurrentThread.CurrentCulture = thisCult MsgBox("Wait...") Dim appProgID As String = "Autocad.Application" + "." + acadver ' Get reference on interface IDispatch Dim AcadType As Type = Type.GetTypeFromProgID(appProgID) ' Run AutoCAD Dim AcadApp As Object = Activator.CreateInstance(AcadType) Dim visargs() As Object = New Object(0) {} ' Set visibility mode to false visargs(0) = False ' Make application visible AcadApp.GetType().InvokeMember("Visible", BindingFlags.SetProperty, Nothing, AcadApp, visargs, Nothing) ' Maximize window ''AcadApp.GetType().InvokeMember("WindowState", BindingFlags.SetProperty, Nothing, AcadApp, New Object() {1}, Nothing) Dim AcadDocs As Object = AcadApp.GetType().InvokeMember("Documents", BindingFlags.GetProperty, Nothing, AcadApp, Nothing) ' Define arguments to open file Dim args() As Object = New Object(1) {} args(0) = fname ' Set read only mode to false args(1) = False ' Try open document Dim AcDoc As Object = AcadDocs.GetType.InvokeMember("Open", BindingFlags.InvokeMethod, Nothing, AcadDocs, args, Nothing) Try ' get reference on active document AcDoc = AcadApp.GetType.InvokeMember("ActiveDocument", BindingFlags.GetProperty, Nothing, AcadApp, Nothing, Nothing) ' Get reference on ModelSpace Dim AcSpace As Object = AcDoc.GetType.InvokeMember("ModelSpace", BindingFlags.GetProperty, Nothing, AcDoc, Nothing) Dim entCount As Integer = Convert.ToInt32(AcSpace.GetType.InvokeMember("Count", BindingFlags.GetProperty, Nothing, AcSpace, Nothing)) ' Loop through selected objects For index As Integer = 0 To entCount - 1 ' Get single item from selection Dim AcEnt As Object = AcSpace.GetType.InvokeMember("Item", BindingFlags.InvokeMethod, Nothing, AcSpace, New Object() {index}) ' Get Object name Dim objName As String = AcEnt.GetType.InvokeMember("ObjectName", BindingFlags.GetProperty, Nothing, AcEnt, Nothing).ToString() Dim textStr As String = String.Empty If objName = "AcDbText" Then textStr = AcEnt.GetType.InvokeMember("TextString", BindingFlags.GetProperty, Nothing, AcEnt, Nothing).ToString() listData.Add(textStr) '_____________________________________________ ' written by Tony Tanzillo '_____________________________________________ ' The array of arguments that will be passed ' to the AcadEntity.GetBoundingBox() method: Dim boxargs As Object() = New Object(1) {} ' In order to get VT_BYREF | VT_VARIANT arguments to be ' filled in by the callee, we must use VariantWrappers ' as the arguments: ' The callee will replace the VariantWrappers ' in the args[] argument array with the results. boxargs(0) = New VariantWrapper(0) boxargs(1) = New VariantWrapper(0) ' We also need to tell the marshaler that ' both parameters in the COM method call are ' 'out' or 'byref' parameters: ' 2 = the total number of arguments passed: Dim pm As New ParameterModifier(2) pm(0) = True ' first argument is byref pm(1) = True ' second argument is byref Dim modifiers As ParameterModifier() = New ParameterModifier() {pm} ' Invoke the method, passing the arguments, and ' the parameter modifers AcEnt.GetType().InvokeMember("GetBoundingBox", BindingFlags.InvokeMethod, Nothing, AcEnt, boxargs, modifiers, Nothing, Nothing) ' The results are now in the args[] array: Dim ll As Double() = DirectCast(boxargs(0), Double()) Dim ur As Double() = DirectCast(boxargs(1), Double()) '________________________________________________________ 'dispay result (debug only) 'MessageBox.Show(String.Format("Point is ({0:f3} , {1:f3} , {2:f3})", ll(0), ll(1), ll(2))) 'draw circle in the midpont of text bounds Dim midPt() As Double = New Double() {(ll(0) + ur(0)) / 2, (ll(1) + ur(1)) / 2, (ll(2) + ur(2)) / 2} DrawCircle(AcSpace, midPt, 0.5) End If Next Dim initDir As String = AcDoc.GetType.InvokeMember("Path", BindingFlags.GetProperty, Nothing, AcDoc, Nothing, Nothing).ToString() Dim saveFileDialog As New System.Windows.Forms.SaveFileDialog saveFileDialog.Title = "Enter a file name to write data: " saveFileDialog.InitialDirectory = initDir saveFileDialog.RestoreDirectory = True saveFileDialog.Filter = "CSV files | *.csv" saveFileDialog.FileName = "File name without extension" Dim result As System.Windows.Forms.DialogResult = saveFileDialog.ShowDialog() If result <> DialogResult.OK Then csvname = "Not saved" Return End If csvname = saveFileDialog.FileName ' Write data to CSV Using sw As New StreamWriter(csvname, True, Encoding.ASCII) For Each strline As String In listData sw.WriteLine(strline) Next End Using 'Save document Dim closeargs() As Object = New Object(1) {} closeargs(0) = True ' with the same name closeargs(1) = fname ' Try close document ' Simplified syntax AcDoc.GetType().InvokeMember("Close", BindingFlags.InvokeMethod, Nothing, AcDoc, closeargs) ' Try quit application AcadApp.GetType().InvokeMember("Quit", BindingFlags.InvokeMethod, Nothing, AcadApp, Nothing) Catch ex As System.Exception MsgBox("Error: " & ex.Message & vbLf & "Trace: " & ex.StackTrace) Finally ' Try quit application AcadApp.GetType().InvokeMember("Quit", BindingFlags.InvokeMethod, Nothing, AcadApp, Nothing) ' clean up the memory '--------------------' ' release Document. releaseObject(AcDoc) ' release Documents. releaseObject(AcadDocs) ' release Application. releaseObject(AcadApp) ' call garbage cleaner immediatelly GC.WaitForPendingFinalizers() GC.GetTotalMemory(True) GC.WaitForPendingFinalizers() GC.GetTotalMemory(True) ' restore current culture System.Threading.Thread.CurrentThread.CurrentUICulture = oldCult 'Display result MsgBox("Csv file saved as : " + csvname) End Try End Sub
~'J'~
Perfect, it worked Hallex. Thank you Hallex Thanks a Lot
You're welcome,
Cheers
~'J'~
Can't find what you're looking for? Ask the community or share your knowledge.