|
|
制作纸本BOM时通常是另存工程图中的零件表再开启Excel编辑成规定的格式
如果可以用程式取出BOM表资料透过自定义的方式输出Excel就可以节省一点时间了
这个程式算是半成品，因为制作Excel的部分还要看使用者需要什么格式
BOM表输出.zip
BOM表输出.txt
Imports SolidWorks.Interop.sldworks
Imports SolidWorks.Interop.swconst
Imports Microsoft.Office.Interop
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 工作表
ExcelApp.Visible = True
'建立活页簿
Workbook = ExcelApp.Workbooks.Add()
'选定工作表
Worksheet = Workbook.Sheets(1)
'显示工作表
ExcelApp.Visible = True
'建立资料字串阵列
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)
'取得零件表物件
swBomFeat = swFeat.GetSpecificFeature2
ProcessBomFeature(SwApp, swModel, swBomFeat)
SwApp.CloseDoc(swModel.GetTitle)
SwApp.ExitApp()
SwApp = Nothing
Exit Do
End If
'取得下一个特徵型态
swFeat = swFeat.GetNextFeature
Loop
End Sub
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
'取得零件表物件
swFeat = swBomFeat.GetFeature
vTableArr = swBomFeat.GetTableAnnotations
For Each vTable In vTableArr
swTable = vTable
vConfigArray = swBomFeat.GetConfigurations(True, True)
For Each vConfig In vConfigArray
'显示组件组态
ConfigName = vConfig
Debug.Print("-------------------------------------------------------")
Debug.Print(" Component for Configuration : " & ConfigName)
'取得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))
'必须先移除被拖曳的元素才能重新加入，不然会发生错误
.items.Remove(InsertItem)
'被拖曳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)
|
|
[复制链接]
发表于 2018-5-24 16:41:36
QQ好友和群
QQ空间
腾讯微博
腾讯朋友
收藏
转播
教程|习题|模型|技巧
点赞
拍砖
鲁公网安备 37028502190335号