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

ts12345600hb · 发表于 2019-8-31 19:27:00

经典图书

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

yuzhouwanchang · 发表于 2019-9-1 00:31:44

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

pjun574 · 发表于 2019-9-1 03:15:56

经典图书

yf2895378 · 发表于 2019-9-1 04:14:42

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) <> "" 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("Sheet1")

SetTableHead '设置Excel的表头的函数

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

ReDim myCommonet(0)

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

'下面9行是往excel输入当前打开的装配体的属性栏的数据，由于遍历装配体不会遍历自身...
xlWs.Range("B" & CurRow).Value = swPart.GetCustomInfoValue("", "图号") '输入属性栏中图号的数据到B2区域，下面类似
xlWs.Range("C" & CurRow).Value = swPart.GetCustomInfoValue("", "文件名称")
xlWs.Range("D" & CurRow).Value = swPart.GetCustomInfoValue("", "数量")
xlWs.Range("E" & CurRow).Value = swPart.GetCustomInfoValue("", "材料")
xlWs.Range("F" & CurRow).Value = swPart.GetCustomInfoValue("", "厚度")
xlWs.Range("G" & CurRow).Value = swPart.GetCustomInfoValue("", "边界框长度")
xlWs.Range("H" & CurRow).Value = swPart.GetCustomInfoValue("", "边界框宽度")
xlWs.Range("I" & CurRow).Value = swPart.GetCustomInfoValue("", "表面处理")
xlWs.Range("J" & CurRow).Value = swPart.GetCustomInfoValue("", "外形尺寸")
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 = "Reference" Or myFeature.GetTypeName2 = "ReferencePattern") 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("B" & CurRow).Value = curmodeldoc.GetCustomInfoValue("", "图号")
xlWs.Range("C" & CurRow).Value = curmodeldoc.GetCustomInfoValue("", "文件名称")
xlWs.Range("D" & CurRow).Value = curmodeldoc.GetCustomInfoValue("", "数量")
xlWs.Range("E" & CurRow).Value = curmodeldoc.GetCustomInfoValue("", "材料")
xlWs.Range("F" & CurRow).Value = curmodeldoc.GetCustomInfoValue("", "厚度")
xlWs.Range("G" & CurRow).Value = curmodeldoc.GetCustomInfoValue("", "边界框长度")
xlWs.Range("H" & CurRow).Value = curmodeldoc.GetCustomInfoValue("", "边界框宽度")
xlWs.Range("I" & CurRow).Value = curmodeldoc.GetCustomInfoValue("", "表面处理")
xlWs.Range("J" & CurRow).Value = curmodeldoc.GetCustomInfoValue("", "外形尺寸")
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 = "Reference" Or myFeatureT.GetTypeName2 = "ReferencePattern") 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("A1:Q1")
.Font.Name = "宋体" '字体样式
.Font.Size = 12 '字体大小
.Font.Bold = True '粗体字
.HorizontalAlignment = xlCenter '中心对齐
End With

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

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

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

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

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

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

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

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

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

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

End Function

binzhonghuang · 发表于 2019-9-1 04:53:49

经典案例图书

效果

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

wenrounanren · 发表于 2019-9-1 10:22:01

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

endragon · 发表于 2019-9-1 12:44:50

经典案例图书

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

j1234567 · 发表于 2019-9-1 13:04:04

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

diyideng3 · 发表于 2019-9-1 13:34:58

前盆友前来顶贴

tongj007 · 发表于 2019-9-1 17:52:05

经典图书

我也想学，

frank918 · 发表于 2019-9-1 19:55:27

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

xinyiyuan · 发表于 2019-9-1 20:04:32

没懂，再看一次

jxl442613 · 发表于 2019-9-2 01:21:04

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

youwen54 · 发表于 2019-9-2 02:30:38

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

candy810714 · 发表于 2019-9-2 03:22:04

加入QQ群
参与讨论和学习

或扫描二维码加入

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

daiheping · 发表于 2019-9-2 04:32:30

经典案例图书

好贴！！！！！！

sunysb · 发表于 2019-9-2 04:49:47

加入QQ群
参与讨论和学习

或扫描二维码加入

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

haobing666666 · 发表于 2019-9-2 06:22:54

经典案例图书

一点都看不懂哈哈哈

ppchong · 发表于 2019-9-2 10:57:06

看不懂

prophetasd · 发表于 2019-9-2 19:54:53

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

		自动登录	找回密码
密码			立即注册

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

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