solidworks根据装配图自动做清单 宏

ts12345600hb

   经典图书

没想到会用宏的人这么少，可惜啊

yuzhouwanchang

此宏是根据开思论坛的 网友 三维专家 编写出来的，三维专家写出来的宏已经很好用了，但有个缺点就是清单的顺序没有按照设计树的顺序，比较乱。
原帖 ww w. ic ax.or g/t hr ead-12560 14-1-1.html
我也参考了3D社 区的一个网友的帖子，在此感谢

pjun574

   经典图书

yf2895378

Dim swApp As SldWorks.SldWorks
Dim swPart As SldWorks.ModelDoc2
Dim xlApp As Excel.Application '需要引用Exelc相关函数,设置引用Microsoft Excel
Dim xlWb As Excel.Workbook
Dim xlWbs As Excel.Workbooks
Dim xlWs As Excel.Worksheet
Dim xlPath As String
Dim xlFN As String
Dim CurRow As Integer
Dim myModelDoc() As SldWorks.ModelDoc2


Sub main()


On Error Resume Next
Set swApp = Application.SldWorks
Set swPart = swApp.ActiveDoc

xlPath = Environ("USERPROFILE") & "Desktop" '获取桌面路径
xlFN = "生产喷涂清单" & ".xlsx" '要保存的Excel文件名称

If Dir(xlPath & xlFN) <> &quot;&quot; Then '如果桌面上有该文件，则删除它
Kill xlPath & xlFN
End If

Set xlApp = Excel.Application
xlApp.Visible = True '新建excel
Set xlWbs = Excel.Workbooks
Set xlWb = xlWbs.Add() '新建工作表
Set xlWs = xlWb.Worksheets(&quot;Sheet1&quot;)

SetTableHead '设置Excel的表头的函数

xlWb.SaveAs xlPath & xlFN '自动保存文件

ReDim myCommonet(0)

CurRow = 2 '在excle填写内容的行数，初始从第二行开始,第一行为表头

'下面9行是往excel输入当前打开的装配体的属性栏的数据，由于遍历装配体不会遍历自身...
xlWs.Range(&quot;B&quot; & CurRow).Value = swPart.GetCustomInfoValue(&quot;&quot;, &quot;图号&quot;) '输入属性栏中图号的数据到B2区域，下面类似
xlWs.Range(&quot;C&quot; & CurRow).Value = swPart.GetCustomInfoValue(&quot;&quot;, &quot;文件名称&quot;)
xlWs.Range(&quot;D&quot; & CurRow).Value = swPart.GetCustomInfoValue(&quot;&quot;, &quot;数量&quot;)
xlWs.Range(&quot;E&quot; & CurRow).Value = swPart.GetCustomInfoValue(&quot;&quot;, &quot;材料&quot;)
xlWs.Range(&quot;F&quot; & CurRow).Value = swPart.GetCustomInfoValue(&quot;&quot;, &quot;厚度&quot;)
xlWs.Range(&quot;G&quot; & CurRow).Value = swPart.GetCustomInfoValue(&quot;&quot;, &quot;边界框长度&quot;)
xlWs.Range(&quot;H&quot; & CurRow).Value = swPart.GetCustomInfoValue(&quot;&quot;, &quot;边界框宽度&quot;)
xlWs.Range(&quot;I&quot; & CurRow).Value = swPart.GetCustomInfoValue(&quot;&quot;, &quot;表面处理&quot;)
xlWs.Range(&quot;J&quot; & CurRow).Value = swPart.GetCustomInfoValue(&quot;&quot;, &quot;外形尺寸&quot;)
CurRow = CurRow + 1 '行数加一

If Not swPart Is Nothing Then '按照设计树遍历当前装配体的全部子装配体和子零件
Dim myFeature As Feature
Set myFeature = swPart.FirstFeature
ReDim myModelDoc(0)
Do While Not myFeature Is Nothing
If (myFeature.GetTypeName2 = &quot;Reference&quot; Or myFeature.GetTypeName2 = &quot;ReferencePattern&quot;) And swPart.GetType = 2 Then
TraFeature swPart, myFeature.Name '调用遍历子装配体函数
End If
Set myFeature = myFeature.GetNextFeature
Loop
End If

xlWb.Save

End Sub


Private Sub TraFeature(ByVal ParModeldoc As SldWorks.ModelDoc2, ByVal ParName As String) '按照设计树顺序遍历装配体 函数
Dim curcomponent As Component2

Set curcomponent = ParModeldoc.GetComponentByName(ParName)
If curcomponent Is Nothing Then
Exit Sub
End If

If curcomponent.IsSuppressed = False Then
Dim curmodeldoc As SldWorks.ModelDoc2
Set curmodeldoc = curcomponent.GetModelDoc2
ReDim Preserve myModelDoc(UBound(myModelDoc) + 1)
Set myModelDoc(UBound(myModelDoc)) = curmodeldoc

'下面9行是往excel输入当前装配体内全部子装配体和子零件的的属性栏的数据
xlWs.Range(&quot;B&quot; & CurRow).Value = curmodeldoc.GetCustomInfoValue(&quot;&quot;, &quot;图号&quot;)
xlWs.Range(&quot;C&quot; & CurRow).Value = curmodeldoc.GetCustomInfoValue(&quot;&quot;, &quot;文件名称&quot;)
xlWs.Range(&quot;D&quot; & CurRow).Value = curmodeldoc.GetCustomInfoValue(&quot;&quot;, &quot;数量&quot;)
xlWs.Range(&quot;E&quot; & CurRow).Value = curmodeldoc.GetCustomInfoValue(&quot;&quot;, &quot;材料&quot;)
xlWs.Range(&quot;F&quot; & CurRow).Value = curmodeldoc.GetCustomInfoValue(&quot;&quot;, &quot;厚度&quot;)
xlWs.Range(&quot;G&quot; & CurRow).Value = curmodeldoc.GetCustomInfoValue(&quot;&quot;, &quot;边界框长度&quot;)
xlWs.Range(&quot;H&quot; & CurRow).Value = curmodeldoc.GetCustomInfoValue(&quot;&quot;, &quot;边界框宽度&quot;)
xlWs.Range(&quot;I&quot; & CurRow).Value = curmodeldoc.GetCustomInfoValue(&quot;&quot;, &quot;表面处理&quot;)
xlWs.Range(&quot;J&quot; & CurRow).Value = curmodeldoc.GetCustomInfoValue(&quot;&quot;, &quot;外形尺寸&quot;)
CurRow = CurRow + 1

If curmodeldoc.GetType = 2 Then
Dim myFeatureT As Feature
Set myFeatureT = curmodeldoc.FirstFeature
Do While Not myFeatureT Is Nothing


If (myFeatureT.GetTypeName2 = &quot;Reference&quot; Or myFeatureT.GetTypeName2 = &quot;ReferencePattern&quot;) And curmodeldoc.GetType = 2 Then
TraFeature curmodeldoc, myFeatureT.Name
End If
Set myFeatureT = myFeatureT.GetNextFeature
Loop
End If
End If
End Sub




'设置表头，用户可根据自己的实际要求进行增删，或修改每列的宽度
Public Function SetTableHead()

With xlWs.Range(&quot;A1:Q1&quot;)
.Font.Name = &quot;宋体&quot; '字体样式
.Font.Size = 12 '字体大小
.Font.Bold = True '粗体字
.HorizontalAlignment = xlCenter '中心对齐
End With

With xlWs.Range(&quot;A1&quot;)
.Value = &quot;序号&quot;
.ColumnWidth = 3 '该列宽度
End With

With xlWs.Range(&quot;B1&quot;)
.Value = &quot;图号&quot;
.ColumnWidth = 20 '该列宽度
End With

With xlWs.Range(&quot;C1&quot;)
.Value = &quot;名称&quot;
.ColumnWidth = 20 '该列宽度
End With

With xlWs.Range(&quot;D1&quot;)
.Value = &quot;数量&quot;
.ColumnWidth = 4 '该列宽度
End With

With xlWs.Range(&quot;E1&quot;)
.Value = &quot;材料&quot;
.ColumnWidth = 10 '该列宽度
End With

With xlWs.Range(&quot;F1&quot;)
.Value = &quot;厚度&quot;
.ColumnWidth = 5 '该列宽度
End With

With xlWs.Range(&quot;G1&quot;)
.Value = &quot;长mm&quot;
.ColumnWidth = 8 '该列宽度
End With

With xlWs.Range(&quot;H1&quot;)
.Value = &quot;宽mm&quot;
.ColumnWidth = 8 '该列宽度
End With

With xlWs.Range(&quot;I1&quot;)
.Value = &quot;颜色&quot;
.ColumnWidth = 11 '该列宽度
End With

With xlWs.Range(&quot;J1&quot;)
.Value = &quot;成型尺寸&quot;
.ColumnWidth = 20
End With

End Function

binzhonghuang

   经典案例图书

效果




我的这个宏的缺点也是很明显。虽然清单的顺序可以按照设计树的来，但不能把同一零件统一起来只输出一项，也就是装配图内数量不是一件的，清单就会多出来了

wenrounanren

自动做清单的思路：
打开一个总装配体，使用此宏，宏会按照设计树的顺序遍历装配体的全部的子装配体和子零件，以及子装配体的子零件，然后导出零件的属性栏里面的数据，输出到Excel

endragon

   经典案例图书

如果宏使用不了，就需要设置引用，编辑宏 - 工具 - 引用

j1234567

钣金的展开尺寸、零件的外形尺寸、装配体的外形尺寸 都可以用宏功能自动链接到属性栏，不需要自己去点击使用，只要了使用常驻宏功能。
自动链接零件和装配体外形尺寸到属性栏的 宏 我在开思论坛发过了。

diyideng3

前盆友前来顶贴

tongj007

   经典图书

我也想学，

frank918

虽然没看懂，但感觉挺不错的。

xinyiyuan

没懂，再看一次

jxl442613

这个程序是为我定制的而已，现在已经不会输出重复项了，我在里面添加了这么多的注释，即使没人编程基础的人应该也是可以看懂

youwen54

没人回复的原因是大多数人都看不懂，嗯，我也不懂。因为书上没有这方面的详细教学......

candy810714

加入QQ群
参与讨论和学习

或扫描二维码加入

可以加个联系方式吗？不太会用，想学一下

daiheping

   经典案例图书

好贴！！！！！！

sunysb

加入QQ群
参与讨论和学习

或扫描二维码加入

pan.b aidu.c om /s/1KFtyj3qaG3 7G0wfmI8O1Mg
程序我不断在改动，让它变得更懂我，图片是输出的清单的效果

haobing666666

   经典案例图书

一点都看不懂 哈哈哈

ppchong

看不懂

prophetasd

很棒 不过如果能把你的属性页贴一下就更好了