Select All

[amitnkukanur]

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

[Hallex · Accepted 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'~

[norman.yuan]

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.

[amitnkukanur]

Perfect, Thankyou Hallex It worked really Great.

Thankyou Hallex for Supporting me.

Thankyou

Regards

Amit

[amitnkukanur]

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

[Hallex]

Glad if you got it to work

Cheers

~'J'~

[Hallex]

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'~

[amitnkukanur]

Ok Hallex i will Work on it using GetBoundingBox method of Texts. Thanks for Reply.

With Warm Regards

Amit

[Hallex]

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'~

[amitnkukanur]

Perfect, it worked Hallex. Thank you Hallex Thanks a Lot

[Hallex]

You're welcome,

Cheers

~'J'~