找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 1349|回复: 0

[分享] Extract data from drawing to xml file

[复制链接]

已领礼包: 859个

财富等级: 财运亨通

发表于 2014-6-7 03:30:01 | 显示全部楼层 |阅读模式

马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。

您需要 登录 才可以下载或查看,没有账号?立即注册

×
     Imports System
Imports System.Text
Imports System.IO
Imports System.Data
Imports System.Reflection
Imports System.Collections.Generic
Imports System.Runtime.InteropServices
Imports System.Text.RegularExpressions
Imports System.Windows.Forms

Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.Colors
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.DataExtraction
''----------------------------------------------------------''
Example how to exract data into the .xml file in Debug folder
''----------------------------------------------------------''

  '' based on Kean Walmsley's example from there:
        '' http://through-the-interface.typ ... xtracting-data.html
        <CommandMethod("exlines")> _
        Public Sub ExtractLines()
            Dim ed As Editor = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor
            Dim starttime As Double
            Dim endtime As Double

            Dim dialog As New System.Windows.Forms.OpenFileDialog

            With dialog
                .CheckPathExists = True
                .CheckPathExists = True
                .DefaultExt = "dxf"
                .DereferenceLinks = True
                .Multiselect = False
                .Filter = "Drawing (*.dwg)|*.dwg|All files (*.*)|*.*"
                .Title = "Select drawing"
                .FilterIndex = 1

            End With

            If dialog.ShowDialog() <> System.Windows.Forms.DialogResult.OK Then
                Return
            End If

            Dim fname As String = dialog.FileName

            starttime = DateAndTime.Timer

            Try

                ''------------------------------------------------------------------------------------------------------''
                ' following datatable easy to write to the any data file (Excel, Access, SQL etc)

                Dim dataTable As System.Data.DataTable = ExtractLines(fname)
                ''------------------------------------------------------------------------------------------------------''
                endtime = DateAndTime.Timer
                '' write data to Lines.xml in the Debug folder
               '' change the full path name of the file if you want to save it in other folder
                dataTable.WriteXml("Lines.xml")

                ed.WriteMessage(vbLf + "Elapsed time: {0:f4} seconds" + vbLf + "Found {1} objects" + vbLf, endtime - starttime, dataTable.Rows.Count)

            Catch ex As System.Exception
                MsgBox(vbCr & ex.ToString & vbCr & ex.StackTrace)
            End Try
            '' Display the  file
            Process.Start("lines.xml", Nothing)
        End Sub

        Public Function extractLines(ByVal fname As String) As System.Data.DataTable
            Dim dataTable As New System.Data.DataTable()
            Dim blkTable As New System.Data.DataTable()
            Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument

            Dim ed As Editor = doc.Editor

            Dim tags As New List(Of String)()
            If Not System.IO.File.Exists(fname) Then
                ed.WriteMessage(vbLf & "Drawing file does not exist.")
                Return Nothing
                Exit Function
            End If
            Dim es As IDxExtractionSettings = New DxExtractionSettings()

            Dim de As IDxDrawingDataExtractor = es.DrawingDataExtractor

            de.Settings.ExtractFlags = ExtractFlags.None Or ExtractFlags.ModelSpaceOnly

            de.Settings.ExtractFlags = ExtractFlags.ExtractBlockOnly ''Or ExtractFlags.ModelSpaceOnly

            Dim fr As IDxFileReference = New DxFileReference(Path.GetDirectoryName(fname), fname)

            de.Settings.DrawingList.AddFile(fr)

            ' Scan the drawing for object types & their properties

            de.DiscoverTypesAndProperties(Path.GetDirectoryName(fname))

            Dim types As List(Of IDxTypeDescriptor) = de.DiscoveredTypesAndProperties

            ' Select all the types and properties for extraction

            ' by adding them one-by-one to these two lists

            Dim selTypes As New List(Of String)()

            Dim selProps As New List(Of String)()

            For Each type As IDxTypeDescriptor In types


                selTypes.Add(type.GlobalName)

                For Each pr As IDxPropertyDescriptor In type.Properties


                    If Not selProps.Contains(pr.GlobalName) Then


                        selProps.Add(pr.GlobalName)
                    End If

                Next
            Next

            de.Settings.SetSelectedTypesAndProperties(types, selTypes, selProps)

            ' Now perform the extraction itself

            de.ExtractData(Path.GetDirectoryName(fname))

            ' Get the results of the extraction

            dataTable = de.ExtractedData

            If dataTable.Rows.Count > 0 Then

                dataTable.TableName = "Lines"

                Dim selrows As DataRow() = dataTable.Select("AcDxObjectTypeGlobalName Like '%Line' Or AcDxObjectTypeGlobalName Like '%Text' Or AcDxObjectTypeGlobalName Like '%MText'")

                blkTable = dataTable.Clone()

                For Each dr As DataRow In selrows
                    blkTable.ImportRow(dr)
                Next
                '' commented lines is just for populating form listbox control
                'Dim columns As String() = New String() {"AcDxObjectTypeName"}

                'Dim dvw As DataView = blkTable.DefaultView
                'distinctTable = dvw.ToTable(False, columns)

                'Dim bnames As New List(Of String)()
                'For Each dr As System.Data.DataRow In distinctTable.Rows
                '    Dim bname As String = dr(0).ToString()
                '    If Not bnames.Contains(bname) Then
                '        bnames.Add(bname)
                '    End If
                'Next

                'Me.lst.DataSource = bnames'' <-- to fill ListBox only

                'lst.SelectedIndex = -1'' <-- set selected items to nothing
            End If

            Return blkTable
        End Function
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-12-19 00:08 , Processed in 0.386782 second(s), 27 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

快速回复 返回顶部 返回列表