跳到主要内容

index

附加到锚点的修订表{ width=600 }

这个VBA宏将修订表插入到活动的SOLIDWORKS图纸的所有或活动工作表中。

修订表附加到修订锚点。

修改宏中的常量以配置修订表选项。

Const ANCHOR_TYPE As Integer = swBOMConfigurationAnchorType_e.swBOMConfigurationAnchor_TopLeft '锚点类型:swBOMConfigurationAnchor_BottomLeft、swBOMConfigurationAnchor_BottomRight、swBOMConfigurationAnchor_TopLeft、swBOMConfigurationAnchor_TopRight
Const TABLE_TEMPLATE As String = "" '修订模板*.sldrevtbt的完整路径,或空字符串使用默认模板
Const SHAPE As Integer = swRevisionTableSymbolShape_e.swRevisionTable_CircleSymbol '符号形状:swRevisionTable_CircleSymbol、swRevisionTable_HexagonSymbol、swRevisionTable_SquareSymbol、swRevisionTable_TriangleSymbol
Const AUTO_UPDATE_ZONE_CELLS As Boolean = True 'True表示自动更新区域单元格

Const ALL_SHEETS As Boolean = True 'True表示处理所有工作表,False表示仅处理活动工作表
Const ANCHOR_TYPE As Integer = swBOMConfigurationAnchorType_e.swBOMConfigurationAnchor_TopRight
Const TABLE_TEMPLATE As String = ""
Const SHAPE As Integer = swRevisionTableSymbolShape_e.swRevisionTable_CircleSymbol
Const AUTO_UPDATE_ZONE_CELLS As Boolean = True

Const ALL_SHEETS As Boolean = True

Dim swApp As SldWorks.SldWorks

Sub main()

Set swApp = Application.SldWorks

Dim swDraw As SldWorks.DrawingDoc

Set swDraw = swApp.ActiveDoc

If ALL_SHEETS Then

Dim vSheetNames As Variant
vSheetNames = swDraw.GetSheetNames

Dim activeSheetName As String
activeSheetName = swDraw.GetCurrentSheet().GetName

Dim i As Integer

For i = 0 To UBound(vSheetNames)
Dim swSheet As SldWorks.sheet
Set swSheet = swDraw.sheet(CStr(vSheetNames(i)))
InsertRevisionTable swDraw, swSheet
Next

swDraw.ActivateSheet activeSheetName

Else
InsertRevisionTable swDraw, swDraw.GetCurrentSheet
End If

End Sub

Sub InsertRevisionTable(draw As SldWorks.DrawingDoc, sheet As SldWorks.sheet)

If False = draw.ActivateSheet(sheet.GetName()) Then
Err.Raise vbError, "", "激活工作表" & sheet.GetName & "失败"
End If

Dim swRevTableAnn As SldWorks.RevisionTableAnnotation

Set swRevTableAnn = sheet.InsertRevisionTable2(True, 0, 0, ANCHOR_TYPE, TABLE_TEMPLATE, SHAPE, AUTO_UPDATE_ZONE_CELLS)

If swRevTableAnn Is Nothing Then
Err.Raise vbError, "", "在" & sheet.GetName & "中插入修订表失败"
End If

End Sub