材料明细表图层宏求助

wjbg2019 · 发表于 2023-4-20 20:25:19

大佬们!我根据API修改了一段代码，但是无法将材料明细表加入到自己想要的图层，求大佬们推荐相关案例，或者帮我修改一下，谢谢！！

Option Explicit

Sub main()

Dim swApp                As SldWorks.SldWorks
Dim swModel                As SldWorks.ModelDoc2
Dim swModelDocExt          As SldWorks.ModelDocExtension
Dim swDrawing             As SldWorks.DrawingDoc
Dim swView                As SldWorks.View
Dim swBOMAnnotation       As SldWorks.BomTableAnnotation
Dim swBOMFeature          As SldWorks.BomFeature
Dim swNote                As SldWorks.Note
Dim boolstatus             As Boolean
Dim AnchorType             As Long
Dim BomType                As Long
Dim Configuration          As String
Dim TableTemplate          As String
Dim Part As Object
Dim longstatus As Long, longwarnings As Long

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swDrawing = swModel
Set swModelDocExt = swModel.Extension
boolstatus = swDrawing.ActivateView("工程图视图4")
Set swView = swDrawing.ActiveDrawingView

' Insert TopLevelOnly BOM table

AnchorType = swBOMConfigurationAnchor_BottomRight '表格位置右下
BomType = swBomType_TopLevelOnly '表格类型：仅限顶层
Configuration = "默认" '默认配置
TableTemplate = "C:\Users\01454613\Desktop\新建文件夹 (22\材料明细表.sldbomtbt"
Set swBOMAnnotation = swView.InsertBomTable2(True, 0.4, 0.3, AnchorType, BomType, Configuration, TableTemplate) 'ture=定位点，falsh=（0.4、0.3）

swBOMAnnotation.Layername = "8符号标注层"

Set swBOMFeature = swBOMAnnotation.BomFeature
Set swApp = Application.SldWorks

Set Part = swApp.ActiveDoc
boolstatus = Part.ActivateView("工程图视图4")
boolstatus = Part.Extension.SelectByID2("工程图视图4", "DRAWINGVIEW", 0, 0, 0, False, 0, Nothing, 0)
boolstatus = Part.ActivateView("工程图视图3")
boolstatus = Part.Extension.SelectByID2("工程图视图3", "DRAWINGVIEW", 0, 0, 0, True, 0, Nothing, 0)
boolstatus = Part.ActivateView("工程图视图2")
boolstatus = Part.Extension.SelectByID2("工程图视图2", "DRAWINGVIEW", 0, 0, 0, True, 0, Nothing, 0)
boolstatus = Part.ActivateView("工程图视图1")
boolstatus = Part.Extension.SelectByID2("工程图视图1", "DRAWINGVIEW", 0, 0, 0, True, 0, Nothing, 0)
Dim vNotes As Variant
Dim autoballoonParams As Object
Set autoballoonParams = Part.CreateAutoBalloonOptions()
autoballoonParams.Layout = 3
autoballoonParams.ReverseDirection = False
autoballoonParams.IgnoreMultiple = True
autoballoonParams.InsertMagneticLine = True
autoballoonParams.LeaderAttachmentToFaces = True
autoballoonParams.Style = 10
autoballoonParams.Size = 2
autoballoonParams.EditBalloonOption = 1
autoballoonParams.EditBalloons = 1
autoballoonParams.UpperTextContent = 1
autoballoonParams.UpperText = """"
autoballoonParams.Layername = "8符号标注层"
vNotes = Part.AutoBalloon5(autoballoonParams)

End Sub

xiaocake · 发表于 2023-4-21 21:12:11

BomTableAnnotation --> BOMFeature --> TableAnnotation --> Annotation --> Layer
有点绕，慢慢研究 API HELP 吧...

wjbg2019 · 发表于 2023-4-20 20:31:28

手动添加明细表可以自动适配图层，但是用宏生成就不能适配图层了，下半部分的自动零件序号没有问题

wjbg2019 · 发表于 2023-4-21 13:47:52

A神，i need you！

Allate · 发表于 2023-4-21 14:01:14

经典案例图书

不知道是不是这样

swBOMAnnotation.Layer = "8符号标注层"

复制代码

wjbg2019 · 发表于 2023-4-21 14:44:57

Allate 发表于 2023-4-21 14:01
不知道是不是这样

Dim swAnnotation As SldWorks.Annotation
swAnnotation.Layername = "8符号标注层"
，加入了这两句，就显示“对象变量未设置了”，感谢大佬的

回答！

Allate · 发表于 2023-4-21 16:23:27

经典案例图书

wjbg2019 发表于 2023-4-21 14:44
Dim swAnnotation As SldWorks.Annotation
swAnnotation.Layername = "8符号标注层" ...

我没说要加这两句话啊，只是提供一种表达方式

wjbg2019 · 发表于 2023-4-21 16:27:48

Allate 发表于 2023-4-21 16:23
我没说要加这两句话啊，只是提供一种表达方式

我觉得应该加一句 set swAnnotation= ，就是不知道等于什么

wjbg2019 · 发表于 2023-4-22 08:03:36

xiaocake 发表于 2023-4-21 21:12
BomTableAnnotation --> BOMFeature --> TableAnnotation --> Annotation --> Layer
有点绕，慢慢研究 AP ...

感谢大佬指路

ppp4537 · 发表于 2023-4-27 09:46:42

楼主太有才了，膜拜中……

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

材料明细表图层宏求助

最佳新人

活跃会员

热心会员

宣传达人

灌水之王

突出贡献

材料明细表 图层 宏 求助

最佳新人

活跃会员

热心会员

宣传达人

灌水之王

突出贡献

材料明细表图层宏求助