SW宏-零件數量自動寫入自定義屬性表

李邈 · 發表于 2024-9-7 09:38:50

本帖最后由李邈于 2024-9-7 09:41 編輯

sycfj 發表于 2024-9-7 09:27 l# [! h1 t# k
能詳細說明怎么使用嗎？我在裝配體中使用這個宏以后，工程圖中不會出現數量

https://baijiahao.baidu.com/s?id=1796657905732909661&wfr=spider&for=pc
按照這個方法設置，他鏈接的是倉庫你連接數量那一欄就行了
設置好之后，把工程圖文件另存為工程圖模板，刪掉上面的視圖，下次新建就會直接出現
以前出的工程圖，用批量替換模板的工具，全部替換成新的工程圖模板就好啦

李邈 · 發表于 2024-9-7 09:40:02

sycfj 發表于 2024-9-7 09:363 _0 y3 X+ C- w7 C
也就是說零件模板中要自定義屬性　數量

這個宏會在每個零件體里添加了自定義屬性數量這一欄，并且把數量填好了
你只要工程圖去連接就行了

sycfj · 發表于 2024-9-7 14:50:39

李邈發表于 2024-9-7 09:25: T/ s: ^0 b1 b2 |2 t0 U3 u3 ~( q4 H
裝配體中使用

還是不會用，加個微sycfj2

李邈 · 發表于 2024-9-7 15:22:48

Type BomPosition
model As SldWorks.ModelDoc2
Configuration As String
Quantity As Double
End Type

Const PRP_NAME As String = "數量"
Const MERGE_CONFIGURATIONS As Boolean = True
Const INCLUDE_BOM_EXCLUDED As Boolean = False

Dim swApp As SldWorks.SldWorks
Sub main()
Set swApp = Application.SldWorks
try_:
On Error GoTo catch_
Dim swAssy As SldWorks.AssemblyDoc
Set swAssy = swApp.ActiveDoc
If swAssy Is Nothing Then
      Err.Raise vbError, "", "Assembly is not opened"
End If
swAssy.ResolveAllLightWeightComponents True
Dim swConf As SldWorks.Configuration
Set swConf = swAssy.ConfigurationManager.ActiveConfiguration
Dim bom() As BomPosition
ComposeFlatBom swConf.GetRootComponent3(True), bom
If (Not bom) <> -1 Then
      WriteBomQuantities bom
End If
GoTo finally_
catch_:
MsgBox Err.Description, vbCritical, "Count Components"
finally_:
End Sub

Sub ComposeFlatBom(swParentComp As SldWorks.Component2, bom() As BomPosition)
Dim vComps As Variant
vComps = swParentComp.GetChildren
If Not IsEmpty(vComps) Then
      Dim i As Integer
      For i = 0 To UBound(vComps)
         Dim swComp As SldWorks.Component2
         Set swComp = vComps(i)
         If swComp.GetSuppression() <> swComponentSuppressionState_e.swComponentSuppressed And (False = swComp.ExcludeFromBOM Or INCLUDE_BOM_EXCLUDED) Then
            Dim swRefModel As SldWorks.ModelDoc2
            Set swRefModel = swComp.GetModelDoc2()
            If swRefModel Is Nothing Then
                  Err.Raise vbError, "", swComp.GetPathName() & " model is not loaded"
            End If
            Dim swRefConf As SldWorks.Configuration
            Set swRefConf = swRefModel.GetConfigurationByName(swComp.ReferencedConfiguration)
            Dim bomChildType As Integer
            bomChildType = swRefConf.ChildComponentDisplayInBOM
            If bomChildType <> swChildComponentInBOMOption_e.swChildComponent_Promote Then
                  Dim bomPos As Integer
                  bomPos = FindBomPosition(bom, swComp)
                  If bomPos = -1 Then
                     If (Not bom) = -1 Then
                        ReDim bom(0)
                     Else
                        ReDim Preserve bom(UBound(bom) + 1)
                     End If
                     bomPos = UBound(bom)
                     Dim refConfName As String
                     If MERGE_CONFIGURATIONS Then
                        refConfName = ""
                     Else
                        refConfName = swComp.ReferencedConfiguration
                     End If
                     Set bom(bomPos).model = swRefModel
                     bom(bomPos).Configuration = refConfName
                     bom(bomPos).Quantity = GetQuantity(swComp)
                  Else
                     bom(bomPos).Quantity = bom(bomPos).Quantity + GetQuantity(swComp)
                  End If
            End If
            If bomChildType <> swChildComponentInBOMOption_e.swChildComponent_Hide Then
                  ComposeFlatBom swComp, bom
            End If
         End If
      Next
End If
End Sub

Function FindBomPosition(bom() As BomPosition, comp As SldWorks.Component2) As Integer
FindBomPosition = -1
Dim i As Integer
If (Not bom) <> -1 Then
      Dim refConfName As String
      If MERGE_CONFIGURATIONS Then
         refConfName = ""
      Else
         refConfName = comp.ReferencedConfiguration
      End If
      For i = 0 To UBound(bom)
         If LCase(bom(i).model.GetPathName()) = LCase(comp.GetPathName()) And LCase(bom(i).Configuration) = LCase(refConfName) Then
            FindBomPosition = i
            Exit Function
         End If
      Next
End If
End Function

Function GetQuantity(comp As SldWorks.Component2) As Double
On Error GoTo err_
Dim refModel As SldWorks.ModelDoc2
Set refModel = comp.GetModelDoc2
Dim qtyPrpName As String
qtyPrpName = GetPropertyValue(refModel, comp.ReferencedConfiguration, "UNIT_OF_MEASURE")
If qtyPrpName <> "" Then
      GetQuantity = CDbl(GetPropertyValue(refModel, comp.ReferencedConfiguration, qtyPrpName))
Else
      GetQuantity = 1
End If
Exit Function
err_:
Debug.Print "Failed to extract quantity of " & comp.Name2 & ": " & Err.Description
GetQuantity = 1
End Function

Function GetPropertyValue(model As SldWorks.ModelDoc2, conf As String, prpName As String) As String
Dim confSpecPrpMgr As SldWorks.CustomPropertyManager
Dim genPrpMgr As SldWorks.CustomPropertyManager
Set confSpecPrpMgr = model.Extension.CustomPropertyManager(conf)
Set genPrpMgr = model.Extension.CustomPropertyManager("")
Dim prpResVal As String
confSpecPrpMgr.Get3 prpName, False, "", prpResVal
If prpResVal = "" Then
      genPrpMgr.Get3 prpName, False, "", prpResVal
End If
GetPropertyValue = prpResVal
End Function

Sub WriteBomQuantities(bom() As BomPosition)
Dim i As Integer
If (Not bom) <> -1 Then
      For i = 0 To UBound(bom)
         Dim refConfName As String
         Dim swRefModel As SldWorks.ModelDoc2
         Set swRefModel = bom(i).model
         If MERGE_CONFIGURATIONS Then
            refConfName = ""
         Else
            refConfName = bom(i).Configuration
            If swRefModel.GetBendState() <> swSMBendState_e.swSMBendStateNone Then
                  Dim swConf As SldWorks.Configuration
                  Set swConf = swRefModel.GetConfigurationByName(refConfName)
                  Dim vChildConfs As Variant
                  vChildConfs = swConf.GetChildren()
                  If Not IsEmpty(vChildConfs) Then
                     Dim j As Integer
                     For j = 0 To UBound(vChildConfs)
                        Dim swChildConf As SldWorks.Configuration
                        Set swChildConf = vChildConfs(j)
                        If swChildConf.Type = swConfigurationType_e.swConfiguration_SheetMetal Then
                              SetQuantity swRefModel, swChildConf.Name, bom(i).Quantity
                        End If
                     Next
                  End If
            End If
         End If
         SetQuantity swRefModel, refConfName, bom(i).Quantity
      Next
End If
End Sub

Sub SetQuantity(model As SldWorks.ModelDoc2, confName As String, qty As Double)
Dim swCustPrpsMgr As SldWorks.CustomPropertyManager
Set swCustPrpsMgr = model.Extension.CustomPropertyManager(confName)
swCustPrpsMgr.Add3 PRP_NAME, swCustomInfoType_e.swCustomInfoText, qty, swCustomPropertyAddOption_e.swCustomPropertyReplaceValue
swCustPrpsMgr.Set2 PRP_NAME, qty
End Sub

我是小劉 · 發表于 2024-9-14 12:31:09

感謝樓主的分享找了好久了

土豆土豆442 · 發表于 2024-10-7 16:38:14

樓主，能求個宏嗎？不會搞

faker558 · 發表于 2024-11-21 16:35:10

看前方發表于 2024-8-14 19:122 v- P% v7 X& J- f5 D0 N+ [" \
一直都是用凱元，自帶了這個功能

在開元沒有看到這個功能啊

faker558 · 發表于 2024-11-21 16:35:50

sycfj 發表于 2024-9-7 09:365 K% |( [! d4 ?/ f3 z- H7 q
也就是說零件模板中要自定義屬性　數量

刷個威望下附件

faker558 · 發表于 2024-11-21 16:36:08

李邈發表于 2024-9-7 09:40+ c. k2 E' X2 M3 A& @
這個宏會在每個零件體里添加了自定義屬性數量這一欄，并且把數量填好了: u1 A1 D1 p7 O1 j) p6 C# u5 R
你只要工程圖去連接就行了

刷個威望下附件

faker558 · 發表于 2024-11-21 16:53:04

sycfj 發表于 2024-9-7 09:24
3 h7 x# C* ^& J1 K這個在工程圖，裝配體，零件哪個環境中使用

裝配體環境中使用

		自動登錄	找回密碼
密碼			注冊會員

久久久国产一区二区_国产精品av电影_日韩精品中文字幕一区二区三区_精品一区二区三区免费毛片爱

SW宏-零件數量自動寫入自定義屬性表

點評