Public Class Form1
'定义拖曳起始与结束的Item位置
Private InitialCount, FinalCount As Integer
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
'建议Excel物件
Dim ExcelApp As New Excel.Application 'ExcelApp是操作 Excel 的变数
Dim Workbook As Excel.Workbook 'Workbook代表的是一个 Excel 本体
Dim Worksheet As Excel.Worksheet 'Worksheet 代表的是 Excel 工作表
'建立资料字串阵列
Dim Data(ListView_BOM.Items.Count - 1, ListView_BOM.Columns.Count - 1) As String
For i = 0 To ListView_BOM.Items.Count - 1
For j = 0 To ListView_BOM.Columns.Count - 1
Data(i, j) = ListView_BOM.Items(i).SubItems(j).Text
Next
Next
Worksheet.Range(Worksheet.Cells(1, 1), Worksheet.Cells(ListView_BOM.Items.Count, ListView_BOM.Columns.Count)).Value = Data
End Sub
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
Dim OpenFile As OpenFileDialog = New OpenFileDialog'创建档案浏览物件
OpenFile.CheckFileExists = True '开启档案不存在警告
OpenFile.Filter = "工程图 (*.SLDDRW)|*.SLDDRW" '设定档案类型
OpenFile.Multiselect = False '禁止复选档案
OpenFile.ShowDialog() '秀出档案浏览视窗
Dim Path As String = OpenFile.FileName '取得档案路径
'判定档案类型
If Strings.Right(Path, 6) = "SLDDRW" Then
GetBOMTable(Path)
Else
MsgBox("档案类型错误")
End If
End Sub
Sub GetBOMTable(ByVal Path As String)
Dim SwApp As New SldWorks
'取得回传讯息
Dim longstatus, longwarnings As Integer
Dim swModel As ModelDoc2 = SwApp.OpenDoc6(Path, swDocumentTypes_e .swDocDRAWING, 0, "", longstatus, longwarnings)
Dim swDraw As DrawingDoc = swModel
Dim swFeat As Feature = swModel.FirstFeature
Dim swBomFeat As BomFeature
'开启含有BOM表的工程图
swModel = SwApp.ActiveDoc
'比对图档内是否有零件表
Do While Not swFeat Is Nothing
If "BomFeat" = swFeat.GetTypeName Then
Debug.Print("******************************")
'显示零件表名称
Debug.Print("Feature Name : " & swFeat.Name)
Sub ProcessBomFeature(ByVal swApp As SldWorks, ByVal swModel As ModelDoc2, ByVal swBomFeat As BomFeature)
Dim swFeat As Feature
Dim vTableArr As Object
Dim vTable As Object
Dim vConfigArray As Object
Dim vConfig As Object
Dim ConfigName As String
Dim swTable As TableAnnotation
'取得BOM表详细资讯
ProcessTableAnn(swApp, swModel, swTable, ConfigName)
Next vConfig
Next vTable
End Sub
Sub ProcessTableAnn(ByVal swApp As SldWorks, ByVal swModel As ModelDoc2, ByVal swTableAnn As TableAnnotation, ByVal ConfigName As String)
Dim BOM As TableAnnotation = swTableAnn
With ListView_BOM
.Columns.Clear()
.Items.Clear()
End With
For i = 1 To swTableAnn.RowCount - 1
Dim RowData(swTableAnn.ColumnCount - 1) As String
For j = 0 To swTableAnn.ColumnCount - 1
If i = 1 Then
With ListView_BOM
.Columns.Add(BOM.DisplayedText(i, j))
.Columns(j).Width = BOM.GetColumnWidth(j) * 6000
End With
Else
RowData(j) = BOM.DisplayedText(i, j)
End If
Next
Dim Item As New ListViewItem(RowData)
ListView_BOM.Items.Add(Item)
Next
End Sub
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
With ListView_BOM
.View = Windows.Forms.View.Details
.GridLines = True
.MultiSelect = False
.AllowDrop = True
.FullRowSelect = True
End With
End Sub
'处发条件:开始Item拖曳
Private Sub ListView_BOM_ItemDrag(sender As Object, e As ItemDragEventArgs) Handles ListView_BOM.ItemDrag
'读取被拖曳Item
Dim SelectItem As ListViewItem = ListView_BOM.SelectedItems.Item(0)
sender.DoDragDrop(SelectItem, DragDropEffects.Move)
End Sub
'触发条件:拖曳完成
Private Sub ListView_BOM_DragDrop(sender As Object, e As DragEventArgs) Handles ListView_BOM.DragDrop
With sender
'取得拖曳完成时的位置
FinalCount = .Items.IndexOf(.HitTest(.PointToClient(New Point(e.X, e.Y))).Item)
'判定拖曳的资料类型是否正确
If e.Data.GetDataPresent(GetType(ListViewItem)) Then
'取得被拖曳的元素
Dim InsertItem As ListViewItem = e.Data.GetData(GetType(ListViewItem))
'被拖曳Item插入位置
If FinalCount = -1 Then
'拖曳至空白区，插入至最下方
.items.add(InsertItem)
Else
'拖曳至Item群组内，插入滑鼠放开的位置
.items.insert(FinalCount, InsertItem)
End If
End If
End With
End Sub
'触发条件：拖曳中
Private Sub ListView_BOM_DragOver(sender As Object, e As DragEventArgs) Handles ListView_BOM.DragOver
'按着滑鼠左键且点选Item时才执行下列程式码
If InitialCount-1 And MouseButtons = MouseButtons.Left Then
'定义拖曳鼠标型态，如果没有使用这个事件与拖曳效果无法完成拖曳
e.Effect = DragDropEffects.Move
End If
End Sub
'触发条件：在ListView内按下滑鼠
Private Sub ListView_BOM_MouseDown(sender As Object, e As MouseEventArgs) Handles ListView_BOM.MouseDown
'取得滑鼠点击时所在的Item位置
InitialCount = ListView_BOM.Items.IndexOf(ListView_BOM.HitTest(e.X, e.Y).Item)
End Sub
'触发条件：拖曳时离开ListView
Private Sub ListView_BOM_DragLeave(sender As Object, e As EventArgs) Handles ListView_BOM.DragLeave
'删除Item
With sender
'按着滑鼠左键且点选Item时才执行下列程式码()
If InitialCount-1 And MouseButtons = MouseButtons.Left And .Items.Count - 1 >= InitialCount Then
.items.removeat(InitialCount)
End If
End With
End Sub
End Class
BOM表輸出.zip
(603.05 KB, 下载次数: 166)
BOM表輸出.txt
(7.86 KB, 下载次数: 233)
