- UID
- 658062
- 积分
- 2147
- 精华
- 贡献
-
- 威望
-
- 活跃度
-
- D豆
-
- 在线时间
- 小时
- 注册时间
- 2008-10-22
- 最后登录
- 1970-1-1
|
马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。
您需要 登录 才可以下载或查看,没有账号?立即注册
×
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 |
|