BOM层次及汇总表=180624

最新推荐文章于 2024-08-22 18:06:31 发布

LI5566123456

最新推荐文章于 2024-08-22 18:06:31 发布

阅读量1.1k

点赞数

文章标签： sketch shell

原文链接：http://www.cnblogs.com/yiguxianyun/p/9603892.html

版权

本文转自某博客，深入探讨了BOM（Bill of Materials）的层次结构及其汇总计算方法，适合产品管理和供应链专业人士阅读。

摘要由CSDN通过智能技术生成

Sub 格式化项目号()
    Set 表字典 = CreateObject("Scripting.Dictionary")
    Call Excel转字典(表字典)
    
    最大级数 = 1
    For Each 行 In 表字典.items
        行("项目号").Select
        a = Split(行("项目号"), ".")
        最大级数 = IIf(UBound(a) + 1 > 最大级数, UBound(a) + 1, 最大级数)
    Next
'    Debug.Print 最大级数
    
    Set 级数字典 = CreateObject("Scripting.Dictionary")
    For 级数 = 1 To 最大级数
        Set 级数字典(级数) = CreateObject("Scripting.Dictionary")
    Next
    For Each 行 In 表字典.items
        行("项目号").Select
        a = Split(行("项目号"), ".")
        当前行级数 = UBound(a) + 1
        For 级数 = 1 To 当前行级数
            级数字典(级数)(行) = a(级数 - 1)
        Next
    Next
    
    For Each 级数 In 级数字典.keys
        最大长度 = 1
        For Each 级数数值 In 级数字典(级数).items
'            Debug.Print 级数数值 & "==" & Len(级数数值)
            最大长度 = IIf(Len(级数数值) > 最大长度, Len(级数数值), 最大长度)
        Next
        占位零 = String(最大长度, "0")
        For Each k In 级数字典(级数).keys
            级数数值 = 级数字典(级数)(k)
'            Debug.Print Format(级数数值, 占位零)
            格式化级数数值 = Format(级数数值, 占位零)
            级数字典(级数)(k) = 格式化级数数值
        Next
    Next
    
    For Each 行 In 表字典.items
        行("项目号").Select
        新项目号 = ""
        For Each 级数 In 级数字典.keys
            级数数值 = 级数字典(级数)(行)
            
            新项目号 = IIf(级数数值 = "", 新项目号, 新项目号 & "." & 级数数值)
        Next
        新项目号 = Mid(新项目号, 2)
        Debug.Print 新项目号
        行("项目号").Value = 新项目号
    Next
    
End Sub
Sub cs()
Debug.Print String(5, "0")

End Sub

Module1格式化项目号

Public swApp As Object, swModel As Object, swFeatMgr As Object, swConfigMgr As Object
Public selData As Object, SelMgr As Object
Public lstatus As Long, lwarnings As Long, lErrors As Long
Public FilePath, Filename, FilenameWHZ As String
Public swFileTYpe As Integer
Public 坐标对象 As Object
Sub sw初始化(ByVal sw全名)
    Set swApp = CreateObject("SldWorks.Application") '启动SW
    If sw全名 = "" Then
        Set swModel = swApp.ActiveDoc
        sw全名 = swModel.GetPathName
    End If
    Call 拆分文件名(sw全名)
    Call 类型判断(sw全名)
    Set swModel = swApp.OpenDoc(sw全名, swFileTYpe) '开启档案
    Set swModel = swApp.ActivateDoc3(sw全名, False, 0, lErrors)
    swset
End Sub
Sub sw初始化_获取指定文件(ByVal sw全名)
    Set swApp = CreateObject("SldWorks.Application") '启动SW
    Call 类型判断(sw全名)
    Set swModel = swApp.GetOpenDocumentByName(sw全名)
    If swModel Is Nothing Then
        Set swModel = swApp.OpenDoc(sw全名, swFileTYpe)
        swModel.Visible = False
    End If
    swset
End Sub
Sub 拆分文件名(ByVal FilePathName)
    FilePath = Left(FilePathName, InStrRev(FilePathName, "\")) '分解路径
    Filename = Right(FilePathName, Len(FilePathName) - Len(FilePath)) '分解文件名
    FilenameWHZ = Left(Filename, Len(Filename) - 7)
End Sub
Sub 类型判断(ByVal FilePathName)
    If UCase(Right(FilePathName, 3)) = "PRT" Then swFileTYpe = 1
    If UCase(Right(FilePathName, 3)) = "LFP" Then swFileTYpe = 1
    If UCase(Right(FilePathName, 3)) = "ASM" Then swFileTYpe = 2
    If UCase(Right(FilePathName, 3)) = "DRW" Then swFileTYpe = 3
    If UCase(Right(FilePathName, 6)) = "DRWDOT" Then swFileTYpe = 3
End Sub
Sub swset()
    Set swFeatMgr = swModel.FeatureManager
    Set SelMgr = swModel.SelectionManager
    Set selData = SelMgr.CreateSelectData
    Set swConfigMgr = swModel.ConfigurationManager
End Sub
Sub 激活窗口()
    If Range("激活sw窗口方式") = "AppActivate" Then
        窗口标题集 = Array( _
        Filename & " - 图纸1", _
        Filename & " - 图纸1 *", _
        FilenameWHZ & " - 图纸1", _
        FilenameWHZ & " - 图纸1 *", _
        FilenameWHZ & " - 图纸2", _
        FilenameWHZ & " - 图纸2 *", _
        Filename, _
        Filename & " *", _
        FilenameWHZ, _
        FilenameWHZ & " *" _
        )
        For Each 窗口标题 In 窗口标题集
            On Error Resume Next
            AppActivate 窗口标题
            If Err.Number <> 0 Then
                Err.Clear
            Else
                Exit For
            End If
        Next
    Else
        sw全名 = swModel.GetPathName
        cmd = "explorer.exe """ & sw全名 & """"
        Shell cmd, 1
    End If
End Sub
Function 映射特征类型(ByVal 原特征类型) As String
    Set d = CreateObject("scripting.dictionary")
    d.Add "ICE", "BODYFEATURE"
    d.Add "Chamfer", "BODYFEATURE"
    d.Add "ProfileFeature", "SKETCH"
    d.Add "DeleteBody", "BODYFEATURE"
    d.Add "BaseBody", "BODYFEATURE"
    d.Add "Cut", "BODYFEATURE"
    d.Add "LPattern", "BODYFEATURE"
    d.Add "HoleWzd", "BODYFEATURE"
    d.Add "Reference", "COMPONENT"
    d.Add "MirrorPattern", "BODYFEATURE"
    d.Add "LocalLPattern", "COMPPATTERN"
    
    If d.Exists(原特征类型) Then
        映射特征类型 = d(原特征类型)
    End If
End Function
Sub 映射图纸大小(ByRef 映射字典)
    Set 映射字典("swto俗称") = CreateObject("scripting.dictionary")
    映射字典("swto俗称").Add swDwgPaperSizes_e.swDwgPaperA3size, "A3"
    映射字典("swto俗称").Add swDwgPaperSizes_e.swDwgPaperA2size, "A2"
    映射字典("swto俗称").Add swDwgPaperSizes_e.swDwgPaperA4sizeVertical, "A4"
    映射字典("swto俗称").Add swDwgPaperSizes_e.swDwgPaperA4size, "A4横"
    
    Set 映射字典("俗称tosw") = CreateObject("scripting.dictionary")
    For Each k In 映射字典("swto俗称")
        映射字典("俗称tosw").Add 映射字典("swto俗称")(k), k
    Next
End Sub
Sub 激活窗口cs()
    Set 窗口标题集 = CreateObject("Scripting.Dictionary")
    窗口标题集.Add "00_kz", ""
    
    For Each 窗口标题 In 窗口标题集.keys
        On Error Resume Next
        AppActivate 窗口标题
        If Err.Number <> 0 Then
            Err.Clear
        Else
            Exit For
        End If
    Next
End Sub

模块1sw初始化_通用

Public Const Const阵列类型名称 As String = "LocalCirPattern|MirrorCompFeat|LocalLPattern|LocalSketchPattern|DerivedHolePattern"
Public Const Const删除项 As String = "参考|ck|作废"
Public Const Const活动项