这段代码的主要目的是检查SolidWorks绘图文档中是否存在等轴测视图(Isometric View)。如果绘图文档中的某个工作表(Sheet)没有等轴测视图,则将该工作表标记为失败项,并通知SolidWorks Design Checker。
'--------------------------------------
' 声明变量
Dim nFailedItemCount As Integer
Dim bCheckStatus As Boolean
Dim swApp As SldWorks.SldWorks
Dim errorCode As Long
' 验证函数
Sub Validate()
' 获取SolidWorks应用程序对象
Set swApp = Application.SldWorks
' 验证文档
bCheckStatus = True
' 声明失败项数组
Dim FailedItemsArr() As String
' 运行检查并获取结果
bCheckStatus = RunCheck(FailedItemsArr)
' 通知SOLIDWORKS Design Checker结果
Dim dcApp As DesignCheckerLib.SWDesignCheck
' 获取SOLIDWORKS Design Checker插件
' 建议使用特定版本的ProgID,例如 "SWDesignChecker.SWDesignCheck.yyyy"
' 参考ISWDesignCheck帮助文档中的备注部分
Set dcApp = swApp.GetAddInObject("SWDesignChecker.SWDesignCheck")
' 设置自定义检查结果
errorCode = dcApp.SetCustomCheckResult(bCheckStatus, (FailedItemsArr))
End Sub
' 运行检查函数
Function RunCheck(ByRef FailedItemsArr() As String) As Boolean
' 声明变量
Dim Part As ModelDoc2
Dim pViews() As View
Dim SheetNames() As String
Dim CurrentActiveSheet As Sheet
Dim strCurrentActiveSheet As String
Dim strIsometric As String
' 每个视图的方向与*Isometric进行比较
strIsometric = "*Isometric"
' 错误处理
On Error GoTo ON_ERROR
' 设置检查状态为通过
RunCheck = True
nFailedItemCount = 0
' 获取SolidWorks应用程序对象
Set swApp = Application.SldWorks
' 获取当前活动文档
Set Part = swApp.ActiveDoc
' 获取文档类型
Dim eDocType As swDocumentTypes_e
eDocType = Part.GetType
' 如果文档类型是绘图
If eDocType = swDocDRAWING Then
Dim pDrawingDoc As DrawingDoc
Set pDrawingDoc = Part
Dim pView As View
' 记住当前活动工作表的名称,以便稍后重新激活
Dim strOriginallyActiveSheet As String
Set CurrentActiveSheet = pDrawingDoc.GetCurrentSheet
strOriginallyActiveSheet = CurrentActiveSheet.GetName
' 获取工作表数量
Dim nSheetCount As Integer
nSheetCount = pDrawingDoc.GetSheetCount
' 设置数组大小
ReDim Preserve SheetNames(nSheetCount) As String
' 激活第一个工作表
Dim isFirstSheet As Boolean
isFirstSheet = False
While isFirstSheet = False
Set CurrentActiveSheet = pDrawingDoc.GetCurrentSheet
strCurrentActiveSheet = CurrentActiveSheet.GetName
pDrawingDoc.SheetPrevious
Dim PrevSheet As Sheet
Dim strPrevSheet As String
Set PrevSheet = pDrawingDoc.GetCurrentSheet
strPrevSheet = PrevSheet.GetName
If strPrevSheet = strCurrentActiveSheet Then
isFirstSheet = True
End If
Wend
' 遍历所有工作表
If nSheetCount > 0 Then
Dim nCount As Integer
For nCount = 1 To nSheetCount
Set CurrentActiveSheet = pDrawingDoc.GetCurrentSheet
strCurrentActiveSheet = CurrentActiveSheet.GetName
SheetNames(nSheetCount) = strCurrentActiveSheet
Debug.Print strCurrentActiveSheet
' 变量用于跟踪工作表中是否存在*Isometric视图
Dim IsIsometricViewPresent As Boolean
' 设置为未找到
IsIsometricViewPresent = False
' 遍历所有视图
Dim nViewCount As Integer
nViewCount = 0
Dim pTempView As View
Set pTempView = pDrawingDoc.GetFirstView
While (Not pTempView Is Nothing)
nViewCount = nViewCount + 1
ReDim Preserve pViews(nViewCount)
Set pViews(nViewCount) = pTempView
' 验证视图
' 检查是否找到*Isometric视图
Dim strViewOrientation As String
strViewOrientation = pViews(nViewCount).GetOrientationName
If strViewOrientation = strIsometric Then
IsIsometricViewPresent = True
End If
Debug.Print pViews(nViewCount).GetOrientationName
Set pTempView = pTempView.GetNextView
Wend ' 结束循环 (While pTempView <> Nothing)
' 如果未找到*Isometric视图,则将工作表名称添加到失败项列表
If IsIsometricViewPresent = False Then
' 重新调整失败项数组以容纳新项
nFailedItemCount = nFailedItemCount + 1
ReDim Preserve FailedItemsArr(1 To 2, 1 To nFailedItemCount) As String
' 将失败实体名称和其类型添加到数组
' 使用这两个信息,失败实体应被高亮显示
' 注意:如果不添加实体类型(例如,本例中的“SHEET”),则无法高亮显示实体
' 也就是说,如果给出错误的实体类型,则无法高亮显示实体
' 参考SOLIDWORKS API帮助文档中的swSelectType_e以找到正确的实体类型
FailedItemsArr(1, nFailedItemCount) = strCurrentActiveSheet
FailedItemsArr(2, nFailedItemCount) = "SHEET"
End If
pDrawingDoc.SheetNext
Next nCount ' 结束循环 (For nCount = 1 To nSheetCount)
End If ' 结束条件 (If nSheetCount > 0)
End If ' 结束条件 (If eDocType = swDocDRAWING)
' 设置检查状态
If nFailedItemCount > 0 Then
RunCheck = False
End If
' 重新激活原始活动工作表
pDrawingDoc.ActivateSheet (strOriginallyActiveSheet)
Exit Function
ON_ERROR:
Debug.Print "Check failed to execute."
End Function