1.22.6.17

[+]增加未标注序号颜色指示

AssemblyInfo.vb

@@ -28,5 +28,5 @@ Imports System.Runtime.InteropServices
 ' You can specify all the values or you can default the Build and Revision Numbers
 ' by using the '*' as shown below:
 
-<Assembly: AssemblyVersion("1.22.5.27")> 
-<Assembly: AssemblyFileVersionAttribute("1.22.5.27")> 
+<Assembly: AssemblyVersion("1.22.6.17")> 
+<Assembly: AssemblyFileVersionAttribute("1.22.6.17")> 
\ No newline at end of file

CHANGELOG

  更新日志

Form/frmInventoryCoding.vb

@@ -19,6 +19,9 @@ Public Class frmInventoryCoding
         If IsInventorOpenDoc() = False Then
             Exit Sub
         End If
+        If ThisApplication.ActiveDocumentType <> kAssemblyDocumentObject Then
+            Exit Sub
+        End If
 
         Dim oAssemblyDocument As AssemblyDocument
 
@@ -150,7 +153,6 @@ Public Class frmInventoryCoding
     End Sub
 
     Private Sub btnSearchCoding_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnSearchCoding.Click
-
         On Error Resume Next
         'PartNum = FindSrtingInSheet(Excel_File_Name, StochNum, Sheet_Name, Table_Array, Col_Index_Num, 0)
         btnSearchCoding.Enabled = False
@@ -172,7 +174,7 @@ Public Class frmInventoryCoding
 
             Dim Table_Array(10) As String
 
-            Table_Array = Split("A,C,D,E", ",")
+            Table_Array = Split(Table_Arrays, ",")
 
             Dim MatchRow As Double   '寻找到的行
 

Form/frmOption.Designer.vb

@@ -74,6 +74,7 @@ Partial Class frmOption
         Me.btnExcelFilePath = New System.Windows.Forms.Button()
         Me.txtexcel文件 = New System.Windows.Forms.TextBox()
         Me.Label13 = New System.Windows.Forms.Label()
+        Me.btnOpenExcelFile = New System.Windows.Forms.Button()
         Me.GroupBox1.SuspendLayout()
         Me.GroupBox2.SuspendLayout()
         Me.GroupBox4.SuspendLayout()
@@ -504,6 +505,7 @@ Partial Class frmOption
         '
         'GroupBox8
         '
+        Me.GroupBox8.Controls.Add(Me.btnOpenExcelFile)
         Me.GroupBox8.Controls.Add(Me.txt查询列)
         Me.GroupBox8.Controls.Add(Me.Label16)
         Me.GroupBox8.Controls.Add(Me.txt查找范围)
@@ -598,6 +600,15 @@ Partial Class frmOption
         Me.Label13.TabIndex = 7
         Me.Label13.Text = "Excel文件："
         '
+        'btnOpenExcelFile
+        '
+        Me.btnOpenExcelFile.Location = New System.Drawing.Point(513, 48)
+        Me.btnOpenExcelFile.Name = "btnOpenExcelFile"
+        Me.btnOpenExcelFile.Size = New System.Drawing.Size(52, 20)
+        Me.btnOpenExcelFile.TabIndex = 17
+        Me.btnOpenExcelFile.Text = "打开"
+        Me.btnOpenExcelFile.UseVisualStyleBackColor = True
+        '
         'frmOption
         '
         Me.AcceptButton = Me.btnOK
@@ -695,5 +706,6 @@ Partial Class frmOption
     Friend WithEvents txt数据表 As System.Windows.Forms.TextBox
     Friend WithEvents txt查询列 As System.Windows.Forms.TextBox
     Friend WithEvents Label16 As System.Windows.Forms.Label
+    Friend WithEvents btnOpenExcelFile As System.Windows.Forms.Button
 
 End Class

Form/frmOption.vb

@@ -222,11 +222,19 @@ Public Class frmOption
 
     Private Sub btnAdd_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnAdd.Click
 
-        If txtBOM导出项.Text = "" Then
-            txtBOM导出项.Text = cbo添加.Text
-        Else
-            txtBOM导出项.Text = txtBOM导出项.Text & "|" & cbo添加.Text
-        End If
+        'If txtBOM导出项.Text = "" Then
+        '    txtBOM导出项.Text = cbo添加.Text
+        'Else
+
+        '//先获取复制文本
+        Dim newstr As String = cbo添加.Text & "|"
+
+        '//获取textBox2 中的光标
+        Dim index As Integer = txtBOM导出项.SelectionStart
+        txtBOM导出项.Text = txtBOM导出项.Text.Insert(index, newstr)
+        txtBOM导出项.SelectionStart = index + newstr.Length
+        txtBOM导出项.Focus()
+        'End If
 
     End Sub
 
@@ -240,12 +248,12 @@ Public Class frmOption
 
     Private Sub btnExcelFilePath_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnExcelFilePath.Click
         Dim NewOpenFileDialog As New OpenFileDialog
-
         With NewOpenFileDialog
             .Title = "打开"
             .FileName = ""
-            '.Filter = "AutoDesk Inventor 工程图文件(*.idw)|*.idw" '添加过滤文件
-            .Multiselect = True '多开文件打开
+            .InitialDirectory = GetFileNameInfo(Excel_File_Name).Folder
+            .Filter = "Excel(*.xlsx;*.xls)|*.xlsx;*.xls" '添加过滤文件
+            .Multiselect = False '多开文件打开
             If .ShowDialog = Windows.Forms.DialogResult.OK Then '如果打开窗口OK
                 If .FileName <> "" Then '如果有选中文件
                     txtexcel文件.Text = .FileName
@@ -255,4 +263,21 @@ Public Class frmOption
             End If
         End With
     End Sub
+
+    Private Sub btnOpenExcelFile_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnOpenExcelFile.Click
+        If IsFileExsts(Excel_File_Name) = True Then
+            Process.Start(Excel_File_Name)
+        Else
+            'excel文件不存在，到服务器下载
+            Dim documentURL As String
+            documentURL = "\\Likai-pc\发行版\2011\最新物料编码.xlsx"
+
+            If IsFileExsts(documentURL) = True Then
+                Dim wc As New System.Net.WebClient
+                wc.DownloadFile(documentURL, Excel_File_Name)
+                Process.Start(Excel_File_Name)
+            End If
+
+        End If
+    End Sub
 End Class
\ No newline at end of file

Form/frmQuitOpen.Designer.vb

@@ -31,7 +31,7 @@ Partial Class frmQuitOpen
         'OK_Button
         '
         Me.OK_Button.Anchor = CType((System.Windows.Forms.AnchorStyles.Bottom Or System.Windows.Forms.AnchorStyles.Right), System.Windows.Forms.AnchorStyles)
-        Me.OK_Button.Location = New System.Drawing.Point(667, 296)
+        Me.OK_Button.Location = New System.Drawing.Point(776, 266)
         Me.OK_Button.Name = "OK_Button"
         Me.OK_Button.Size = New System.Drawing.Size(75, 28)
         Me.OK_Button.TabIndex = 2
@@ -41,7 +41,7 @@ Partial Class frmQuitOpen
         '
         Me.Cancel_Button.Anchor = CType((System.Windows.Forms.AnchorStyles.Bottom Or System.Windows.Forms.AnchorStyles.Right), System.Windows.Forms.AnchorStyles)
         Me.Cancel_Button.DialogResult = System.Windows.Forms.DialogResult.Cancel
-        Me.Cancel_Button.Location = New System.Drawing.Point(747, 296)
+        Me.Cancel_Button.Location = New System.Drawing.Point(856, 266)
         Me.Cancel_Button.Name = "Cancel_Button"
         Me.Cancel_Button.Size = New System.Drawing.Size(75, 28)
         Me.Cancel_Button.TabIndex = 3
@@ -59,7 +59,7 @@ Partial Class frmQuitOpen
         Me.lvwFileListView.Location = New System.Drawing.Point(12, 12)
         Me.lvwFileListView.MultiSelect = False
         Me.lvwFileListView.Name = "lvwFileListView"
-        Me.lvwFileListView.Size = New System.Drawing.Size(810, 266)
+        Me.lvwFileListView.Size = New System.Drawing.Size(919, 236)
         Me.lvwFileListView.Sorting = System.Windows.Forms.SortOrder.Ascending
         Me.lvwFileListView.TabIndex = 37
         Me.lvwFileListView.UseCompatibleStateImageBehavior = False
@@ -67,14 +67,14 @@ Partial Class frmQuitOpen
         '
         'ColumnHeader1
         '
-        Me.ColumnHeader1.Text = "文件名"
-        Me.ColumnHeader1.Width = 650
+        Me.ColumnHeader1.Text = "文件名(双击打开)"
+        Me.ColumnHeader1.Width = 900
         '
         'frmQuitOpen
         '
         Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 12.0!)
         Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
-        Me.ClientSize = New System.Drawing.Size(834, 336)
+        Me.ClientSize = New System.Drawing.Size(943, 306)
         Me.Controls.Add(Me.lvwFileListView)
         Me.Controls.Add(Me.OK_Button)
         Me.Controls.Add(Me.Cancel_Button)

Form/frmQuitOpen.vb

@@ -16,11 +16,15 @@ Public Class frmQuitOpen
         Me.Close()
     End Sub
 
-    Private Sub lvwFileListView_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles lvwFileListView.SelectedIndexChanged
+    Private Sub lvwFileListView_MouseDoubleClick(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles lvwFileListView.MouseDoubleClick
         If lvwFileListView.SelectedItems.Count <> 0 Then
             'ThisApplication.Documents.Open(lvwFileListView.SelectedItems(0).Text)
             Process.Start(lvwFileListView.SelectedItems(0).Text)
         End If
         Me.Close()
     End Sub
+
+    Private Sub frmQuitOpen_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
+
+    End Sub
 End Class

Module/Inventorbasic.vb

@@ -9,6 +9,8 @@ Imports System.Windows.Forms
 Imports Inventor.PrintOrientationEnum
 Imports System.Text
 Imports System.Collections.ObjectModel
+Imports Microsoft.Office.Interop.Excel.XlFileFormat
+Imports Microsoft.Office.Interop
 
 Module InventorBasic
 
@@ -1434,20 +1436,93 @@ Module InventorBasic
         Dim oPartsListRows As PartsListRows = oActiveSheet.PartsLists.Item(1).PartsListRows
 
         Dim strList As String = ""
+
+        '新建颜色
+        Dim oColor As Color
+        oColor = ThisApplication.TransientObjects.CreateColor(255, 0, 128)
+
+        Dim strPartName As String
         For Each oPartsListRow As PartsListRow In oPartsListRows
-            If oPartsListRow.Ballooned = False Then
-                strList = strList & oPartsListRow.Item(1).Value & " , "
+            'If oPartsListRow.Ballooned = False Then
+            'strList = strList & oPartsListRow.Item(1).Value & " , "
+
+            strPartName = GetFileNameInfo(oPartsListRow.ReferencedFiles(1).FullFileName).ONlyName
+
+            '设置颜色
+            SetPartCorlor(oDrawingDocument, strPartName, oColor, oPartsListRow.Ballooned)
+            'End If
+        Next
+
+        Return True
+
+        'If Strings.Len(strList) > 1 Then
+        '    MsgBox("明细表：" & strList & " 无序号", MsgBoxStyle.Information, "检查序号完整性")
+        '    Return False
+        'Else
+        '    Return True
+        'End If
+
+    End Function
+
+    '设置工程图零件颜色(工程图，零件，颜色，是否有序号)
+    Public Sub SetPartCorlor(ByVal oDrawingDocument As DrawingDocument, ByVal partStr As String, ByVal oColor As Color, ByVal oPartsListRowBallooned As Boolean)
+
+        Dim oTrans As Transaction
+        Dim refAssyDef As ComponentDefinition = Nothing
+
+        oTrans = ThisApplication.TransactionManager.StartTransaction(oDrawingDocument, "Colorize [PART]")
+        '遍历图纸
+        For Each sheet As Sheet In oDrawingDocument.Sheets
+            '遍历视图
+            For Each view As DrawingView In sheet.DrawingViews
+
+                If view.ReferencedDocumentDescriptor.ReferencedDocumentType = DocumentTypeEnum.kPresentationDocumentObject Then
+                    refAssyDef = view.ReferencedDocumentDescriptor.ReferencedDocument.ReferencedDocuments(1).ComponentDefinition
+                ElseIf view.ReferencedFile.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject Then
+                    refAssyDef = view.ReferencedFile.DocumentDescriptor.ReferencedDocument.ComponentDefinition
+                End If
+
+                If (refAssyDef Is Nothing) Then
+                    Continue For
                 End If
+
+                For Each occurrence As ComponentOccurrence In refAssyDef.Occurrences
+                    If occurrence.Name Like partStr & ":*" Then
+
+                        Try
+                            Dim ViewCurves As DrawingCurvesEnumerator = view.DrawingCurves(occurrence)
+
+                            If oPartsListRowBallooned = True Then
+                                '已有序号，判断颜色属性
+                                '设置颜色
+                                Dim oBlackColor As Color = ThisApplication.TransientObjects.CreateColor(0, 0, 0)
+
+                                For Each c As DrawingCurve In ViewCurves
+                                    Select Case c.Color.ColorSourceType
+                                        Case ColorSourceTypeEnum.kAutomaticColorSource, ColorSourceTypeEnum.kLayerColorSource
+                                            Exit For
+                                        Case ColorSourceTypeEnum.kOverrideColorSource
+                                            c.Color = Nothing
+                                            c.Color.ColorSourceType = ColorSourceTypeEnum.kLayerColorSource
+                                            'c.Color = oBlackColor
+                                    End Select
                                 Next
 
-        If Strings.Len(strList) > 1 Then
-            MsgBox("明细表：" & strList & " 无序号", MsgBoxStyle.Information, "检查序号完整性")
-            Return False
                             Else
-            Return True
+                                '没有序号，设置彩色
+                                For Each c As DrawingCurve In ViewCurves
+                                    c.Color = oColor
+                                Next
                             End If
 
-    End Function
+                        Catch ex As Exception
+                        End Try
+                    End If
+                Next
+            Next
+        Next
+        oTrans.End()
+    End Sub
 
     Public Function InsertSerialNumber(ByVal oDrawingDocument As DrawingDocument) As Boolean
         Dim oActiveSheet As Sheet
@@ -1934,8 +2009,10 @@ Module InventorBasic
     End Function
 
     '导出 bom 平面性
-    Public Function ExportBOMAsFlat(ByVal oAssemblyDocument As AssemblyDocument, ByVal ExcelFullFileName As String) As Boolean
+    Public Function ExportBOMAsFlat(ByVal oAssemblyDocument As AssemblyDocument, ByVal oCsv_File_Name As String) As Boolean
         Dim FirstLevelOnly As Boolean
+
+
         FirstLevelOnly = False
 
         '==============================================================================================
@@ -1953,10 +2030,10 @@ Module InventorBasic
         'ColumnsTitle = "库存编号|空格|零件代号|材料|质量|所属装配代号|数量|总数量|描述"
 
         Dim IOS2 As System.IO.StreamWriter
-        If IsFileExsts(ExcelFullFileName) = False Then
-            IOS2 = New IO.StreamWriter(ExcelFullFileName, False, System.Text.Encoding.Default)
+        If IsFileExsts(oCsv_File_Name) = False Then
+            IOS2 = New IO.StreamWriter(oCsv_File_Name, False, System.Text.Encoding.Default)
         Else
-            IOS2 = New IO.StreamWriter(ExcelFullFileName, True, System.Text.Encoding.Default)
+            IOS2 = New IO.StreamWriter(oCsv_File_Name, True, System.Text.Encoding.Default)
         End If
 
         '写BOM表头
@@ -1971,17 +2048,60 @@ Module InventorBasic
         For Each oBOMView In oBOM.BOMViews
             If oBOMView.ViewType = BOMViewTypeEnum.kStructuredBOMViewType Then
                 '遍历这个bom页面
-                QueryBOMRowPropertieToExcel(ExcelFullFileName, oBOMView.BOMRows, FirstLevelOnly, BOMTiTle, "0", 1)
+                QueryBOMRowPropertieToExcel(oCsv_File_Name, oBOMView.BOMRows, FirstLevelOnly, BOMTiTle, "0", 1)
             End If
         Next
 
+        '转换excel文件格式
+        '===========================================================================
+
+        Dim oExcel_File_Name As String
+        oExcel_File_Name = Strings.Replace(oCsv_File_Name, "csv", "xlsx")
+        If IsFileExsts(oExcel_File_Name) Then
+            DelFile(oExcel_File_Name, FileIO.RecycleOption.SendToRecycleBin)
+        End If
+
+        Dim excelApp As Excel.Application
+        excelApp = New Excel.Application
+        excelApp.Visible = false
+        Dim oWorkbook As Excel.Workbook
+        oWorkbook = excelApp.Workbooks.Open(oCsv_File_Name)
+
+        '另存为xlsx格式
+        DelFile(oExcel_File_Name, FileIO.RecycleOption.SendToRecycleBin)
+        oWorkbook.SaveAs(oExcel_File_Name, xlWorkbookDefault)
+        oWorkbook.Close(False)
+        '删除 csv
+        DelFile(oCsv_File_Name, FileIO.RecycleOption.SendToRecycleBin)
+
+        oWorkbook = excelApp.Workbooks.Open(oExcel_File_Name)
+
+        Dim oWorksheet As Excel.Worksheet
+        oWorksheet = oWorkbook.Worksheets(1)
+
+        '设边框线
+        'oWorksheet.Cells.Borders.LineStyle = 1
+        '所有单元格列宽自动调整
+        oWorksheet.Cells.EntireColumn.AutoFit()
+        '所有单元格行高自动调整
+        oWorksheet.Cells.EntireRow.AutoFit()
+
+        oWorkbook.Close(True)
+        '===========================================================================
+
+        excelApp.Quit()
+
+        System.Runtime.InteropServices.Marshal.ReleaseComObject(excelApp)
+
+        Process.Start(oExcel_File_Name)
         Return True
 
     End Function
 
     '在 bom平面性导出，遍历bom 行文件ipro
-    Private Sub QueryBOMRowPropertieToExcel(ByVal ExcelFullFileName As String, ByVal oBOMRows As BOMRowsEnumerator, ByVal FirstLevelOnly As Boolean, ByVal ColumnsTitle As String, _
+    Private Sub QueryBOMRowPropertieToExcel(ByVal oCsv_File_Name As String, ByVal oBOMRows As BOMRowsEnumerator, ByVal FirstLevelOnly As Boolean, ByVal ColumnsTitle As String, _
                                             ByVal Level As String, ByVal PresentNumber As Integer)
+        On Error Resume Next
 
         Dim i As Short
         Dim j As Short
@@ -2093,9 +2213,11 @@ Module InventorBasic
                             Case "材料"
                                 Dim strMaterialName As String
                                 If oInventorDocument.DocumentType = kPartDocumentObject Then
-                                    Dim IptDoc As PartDocument
-                                    IptDoc = oInventorDocument
-                                    strMaterialName = IptDoc.ComponentDefinition.Material.Name
+                                    'Dim IptDoc As PartDocument
+                                    'IptDoc = oInventorDocument
+                                    'strMaterialName = IptDoc.ComponentDefinition.Material.Name
+                                    propitem = oPropSet.ItemByPropId(Inventor.PropertiesForDesignTrackingPropertiesEnum.kMaterialDesignTrackingProperties)
+                                    strMaterialName = propitem.Value
                                 Else
                                     strMaterialName = ""
                                 End If
@@ -2154,10 +2276,10 @@ Module InventorBasic
 
                     '写数据到文件
                     Dim IOS As System.IO.StreamWriter
-                    If IsFileExsts(ExcelFullFileName) = False Then
-                        IOS = New IO.StreamWriter(ExcelFullFileName, False, System.Text.Encoding.Default)
+                    If IsFileExsts(oCsv_File_Name) = False Then
+                        IOS = New IO.StreamWriter(oCsv_File_Name, False, System.Text.Encoding.Default)
                     Else
-                        IOS = New IO.StreamWriter(ExcelFullFileName, True, System.Text.Encoding.Default)
+                        IOS = New IO.StreamWriter(oCsv_File_Name, True, System.Text.Encoding.Default)
                     End If
                     IOS.WriteLine(ColumnsTitleValue)
                     IOS.Close()
@@ -2177,10 +2299,10 @@ Module InventorBasic
         '写数据到文件
 
         Dim IOS2 As System.IO.StreamWriter
-        If IsFileExsts(ExcelFullFileName) = False Then
-            IOS2 = New IO.StreamWriter(ExcelFullFileName, False, System.Text.Encoding.Default)
+        If IsFileExsts(oCsv_File_Name) = False Then
+            IOS2 = New IO.StreamWriter(oCsv_File_Name, False, System.Text.Encoding.Default)
         Else
-            IOS2 = New IO.StreamWriter(ExcelFullFileName, True, System.Text.Encoding.Default)
+            IOS2 = New IO.StreamWriter(oCsv_File_Name, True, System.Text.Encoding.Default)
         End If
         '写空白行
         IOS2.WriteLine("")
@@ -2220,7 +2342,7 @@ Module InventorBasic
 
                     '遍历下一级
                     If (Not oRow.ChildRows Is Nothing) And FirstLevelOnly = False Then
-                        Call QueryBOMRowPropertieToExcel(ExcelFullFileName, oRow.ChildRows, FirstLevelOnly, ColumnsTitle, PointItemNumber, oRow.ItemQuantity)
+                        Call QueryBOMRowPropertieToExcel(oCsv_File_Name, oRow.ChildRows, FirstLevelOnly, ColumnsTitle, PointItemNumber, oRow.ItemQuantity)
                     End If
 99:
                     'oProgressBar.UpdateProgress()

Module/excelcode.vb

@@ -61,14 +61,14 @@ Module excelcode
     End Function
 
 
-    Public Function FindSrtingInSheet(ByVal Excel_File_Name As String, ByVal StochNum As String, ByVal Sheet_Name As String, _
+    Public Function FindSrtingInSheet(ByVal oExcel_File_Name As String, ByVal StochNum As String, ByVal Sheet_Name As String, _
                                 ByVal Table_Arrays As String, ByVal Col_Index_Num As String, ByVal range_lookup As Integer) As String
 
         On Error Resume Next
         Dim excelApp As Excel.Application
         excelApp = New Excel.Application
         'excelApp.Visible = True
-        Dim wb As Excel.Workbook = excelApp.Workbooks.Open(Excel_File_Name, 0, True)
+        Dim wb As Excel.Workbook = excelApp.Workbooks.Open(oExcel_File_Name, 0, True)
         Dim sht As Excel.Worksheet = Nothing
         Dim FindRowValue As String = Nothing
         sht = wb.Sheets(Sheet_Name)

StandardAddInServer.vb

 '设置为一个动作，可一次撤销