Hello There, I am doing a project where am required to open AutoCAD Database and Extract Data from AutoCAD.
I am using VB.Net as Front End.
I am not using NetLoad.
Directly i am opening the AutoCAD Drawing and trying to access the data.
But all my attempts are unsuccessful anybody has solution
acadApp = CreateObject("AutoCAD.Application")
acadApp.Visible = False
Dim ValCount As Integer = 0
'acadDoc = acadApp.Documents.Open(Files(ValCount), True, Type.Missing)
acadApp.Documents.Open("C:\SomeDwg.dwg", True, Type.Missing)
acadApp.Visible=false
Now using acadApp i am trying to extract Data as AcadApp has AutoCAD Drawing
Can you Guide me, on how to solve this
Solved! Go to Solution.
Solved by Hallex. Go to Solution.
Hi,
>> But all my attempts are unsuccessful
So you get an error message? Or what attemts did you try and how did they fail?
>> Now using acadApp i am trying to extract Data as AcadApp has AutoCAD Drawing
The question following to that is: what do you want to extract? BlockReferences, containing attributes or text-objects or titleblock-information or polylines or ....?
- alfred -
Dim progID As String = "AutoCAD.Application"
Try
acadApp = GetObject(progID)
Catch ex As Exception
Try
Dim acType As Type = GetTypeFromProgID(progID)
acadApp = Activator.CreateInstance(acType, True)
acadApp.Visible = False
acadApp.Documents.Open(Files(0), True, Type.Missing)
acadDoc = acadApp.ActiveDocument.Database
acadDB = acadDoc.Database
Catch exx As Exception
End Try
Here i launch a autoCAD instance and open a document files(0). Files(0) is an array which has 100 drawings and i am selecting first one.
Now in this below i am trying to open the autocad database and extract information which is MText or Text.
Can you Guide me
Author = acadDB.SummaryInfo.Author
FullName = acadDB.Filename
Version = System.Enum.GetName(GetType(Autodesk.AutoCAD.DatabaseServices.DwgVersion), acadDB.LastSavedAsVersion)
Dim myDwgIO As New IO.FileInfo(acadDB.Filename)
If myDwgIO.Exists Then
Nameee = myDwgIO.Name
LastSaved = myDwgIO.LastWriteTime
Sizeee = myDwgIO.Length
End If
Using myTrans As Transaction = acadDB.TransactionManager.StartTransaction
Dim myBT As BlockTable = acadDB.BlockTableId.GetObject(OpenMode.ForRead)
Dim myModelSpace As BlockTableRecord = myBT(BlockTableRecord.ModelSpace).GetObject(OpenMode.ForRead)
For Each myObjID As ObjectId In myModelSpace
Dim myEnt As Entity = myObjID.GetObject(OpenMode.ForRead)
If TypeOf myEnt Is DBText Then
Dim myText As DBText = myEnt
Dim myExtText As New extractText
'Dim myExtTextPosition As New extractText
myExtText.Handle = myText.Handle.ToString
myExtText.Layer = myText.Layer
myExtText.Position = myText.Position
myExtText.TextString = myText.TextString
Texts.Add(myExtText)
Sample.Add(myText.TextString)
ElseIf TypeOf myEnt Is MText Then
Dim urText As MText = myEnt
Dim urExtText As New extractText
urExtText.Handle = urText.Handle.ToString
urExtText.Layer = urText.Layer
'urExtText.Position = urText.Position
'urExtText.TextString = urText.textString
Texts.Add(urExtText)
Dim aaaa As String = urText.Text
Sample.Add(urText.Text)
End If
Next
End Using
The error I get is cannot open acadDB. My aim is to open database and get Texts and i am using the this above method
Can you provide me some solutions or some suggestions on how to solve this.
Regards
Amit
Hi,
in your first part there is at least one "End Try" missing 😉
To your global procedure: If you use an EXE and start AutoCAD using the ActiveX/COM-Interface you cannot mix it up with managed-access. ObjectID, TransAction, .... all that could only be used within DLL's that are NETLOADed or loaded with the plugin-functionality.
Next point to that code:
acadDoc = acadApp.ActiveDocument.Database
acadDB = acadDoc.Database
....the orange part is wrong. If you work with option strict on you would have seen that as type-conflict.
And to scan the ModelSpace now can be done in that way:
Dim tEnt as AcadEntity
For each tEnt in AcadDB.ModelSpace
...
Next
HTH, - alfred -
But i am opening AutoCAD at Background, only difference is the visibility is false. So is it possible to execute like that.
AutoCAD is open at background and can we run the code for accessing database
Or else is it possible to access the Working Database of already Opened AutoCAD Drawing. Like we have HostApplicationServices.WorkingDatabase
Am stuck up here: HostApplicationServices.WorkingDatabase
Now am trying to Connect to this using the created instance of AutoCAD
But There might be some or other way to access the Database services of AutoCAD using AutoCAD Instance, because the application which i am developing runs outside autocad using Its instance not using Netload
Hi,
You can access AutoCAD-drawings from outside AutoCAD, but as you wrote that you don't have a DLL and you don't start _NETLOAD to load a managed DLL you can't have managed access/functions working.
You can access AutoCAD-drawings by using the ActiveX/COM functionality. So you can start AutoCAD e.g. with CreateObject(,"AutoCAD.Application"), you can then access the current drawing with .ActiveDocument and you can scan the modelspace (or other drawing-internals) then.
That you did open the application using .Visible = False has nothing to do with accessing it with managed or with COM-functionality.
Again, as long as you don't create a DLL that could be loaded with _NETLOAD you can't use the managed functions.
Find attached a sample that starts or connects to AutoCAD, opens a drawing and scans the modelspace, it's not tested, it's just written to give you a way.
- alfred -
Yes it worked, as per expectations but when i try to alter the code to meet my expectations it gives error.
I am sending my copy of code have a look at it.
I am working on it and trying to incorporate your logic, Can you make some changes and Test
On Netload open the Drawing in Folder
Hi,
>> On Netload open the Drawing in Folder
??? What is your goal now?
In your first messages you wrote that you create an EXE and you don't use _NETLOAD.
Now you sent a project that creates a DLL and I should do a _NETLOAD. For that case now my previous sample is irrelevant as it is a demo-project for how to control AutoCAD from an external EXE.
Back to your DLL now. I updated the references (2 managed and 2 interops) started AutoCAD in debug-mode, _NETLOADed the DLL, started command "TESTING" and got this dialog.
I don't know it that dialog is ok or not. It starts, it does not make any exception, it shows a dialog with some values in it .... what's wrong then? I can search for a problem, but I don't see any or you have not pointed me to your problem clearly enough.
- alfred -
Earlier i did like this. But now the same thing i am required to extract using standard exe using Instance of AutoCAD. This is Netload One. But now we are required to eliminate this option and using standard Exe we have to get this
The data which is displayed is the WindowsForm. I am trying to get this but not been able to do this.
Regards
Amit
Hi,
OK, now I understand (at least I hope so).
I did show you in my demo-project how you can access entities in modelspace using COM, so please try to get the text-objects by yourself based on what I showed you on how to loop through the modelspace, just don't use an ObjectID.
- alfred -
Ok Thanks for Guiding me through out this project. I will try to get text objects and avoid objectID.
Probably if you find any ideas of solutions keep me posted on this.
With Warm Regards
Amit
Software Engineer
This will get you started
<System.Security.SuppressUnmanagedCodeSecurity()> _ Public Shared Sub ReadTexts() ' Set application version ( I use 17 for A2009, 18 is for A2010) Dim acadver As String = "17" ' 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 one 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) = True ' 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() {3}, 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) ''--------------------------------------------------'' 'Try ' '' Set Try Catch block to avoid crash application ' '' if any items does not exists : ' Dim AcSuminfo As Object = AcDoc.GetType.InvokeMember("SummaryInfo", BindingFlags.GetProperty, Nothing, AcDoc, Nothing) ' Dim Author As Object = AcSuminfo.GetType.InvokeMember("Author", BindingFlags.GetProperty, Nothing, AcSuminfo, Nothing) ' Dim Comments As Object = AcSuminfo.GetType.InvokeMember("Comments", BindingFlags.GetProperty, Nothing, AcSuminfo, Nothing) ' Dim HyperlinkBase As Object = AcSuminfo.GetType.InvokeMember("HyperlinkBase", BindingFlags.GetProperty, Nothing, AcSuminfo, Nothing) ' Dim Keywords As Object = AcSuminfo.GetType.InvokeMember("Keywords", BindingFlags.GetProperty, Nothing, AcSuminfo, Nothing) ' Dim LastSavedBy As Object = AcSuminfo.GetType.InvokeMember("LastSavedBy", BindingFlags.GetProperty, Nothing, AcSuminfo, Nothing) ' Dim RevisionNumber As Object = AcSuminfo.GetType.InvokeMember("RevisionNumber", BindingFlags.GetProperty, Nothing, AcSuminfo, Nothing) ' Dim Subject As Object = AcSuminfo.GetType.InvokeMember("Subject", BindingFlags.GetProperty, Nothing, AcSuminfo, Nothing) ' Dim Title As Object = AcSuminfo.GetType.InvokeMember("Title", BindingFlags.GetProperty, Nothing, AcSuminfo, Nothing) ' ' Add and display standard properties ' MsgBox("The standard drawing properties are " & vbLf & _ ' "Author = " & Author.ToString() & vbLf & _ ' "Comments = " & Comments.ToString() & vbLf & _ ' "HyperlinkBase = " & HyperlinkBase.ToString() & vbLf & _ ' "Keywords = " & Keywords.ToString() & vbLf & _ ' "LastSavedBy = " & LastSavedBy.ToString() & vbLf & _ ' "RevisionNumber = " & RevisionNumber.ToString() & vbLf & _ ' "Subject = " & Subject.ToString() & vbLf & _ ' "Title = " & Title.ToString()) 'Catch 'End Try ''--------------------------------------------------'' 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 Public Shared Sub releaseObject(ByVal obj As Object) Try System.Runtime.InteropServices.Marshal.FinalReleaseComObject(obj) obj = Nothing Catch ex As System.Exception obj = Nothing Finally GC.Collect() End Try End Sub
~'J'~
Yes, It Worked. Thanks a Lot Hallex. Thankyou very Much Hallex for Supporting Me. Thanks a Lot.
Thanks Alfred Neswadba for Guiding me. Thanks a Lot
Thank You
With Warm Regards
Amit
Software Engineer
Glad to help
cheers
~'J'~
Is it possible to use select All option instead of selecting/prompting user to select on screen but hide autocad (donot display)
Can't find what you're looking for? Ask the community or share your knowledge.