Follow along with the video below to see how to install our site as a web app on your home screen.
Note: This feature may not be available in some browsers.
Dim swApp As SldWorks.SldWorks
Dim swDoc As SldWorks.ModelDoc2
Dim swConfigMgr As SldWorks.ConfigurationManager
Dim swConfig As SldWorks.Configuration
Dim swConfigs As Variant
Dim swFM As SldWorks.FeatureManager
Dim swFeat As SldWorks.Feature
Dim i As Long
Dim sMsg As String
Dim Wait As Long
Dim errCnt As Long
Dim bHadErr As Boolean
Sub main()
Set swApp = Application.SldWorks
Set swDoc = swApp.ActiveDoc
Set swConfigMgr = swDoc.ConfigurationManager
swConfigs = swDoc.GetConfigurationNames
Set swFM = swDoc.FeatureManager
sMsg = "Errors found in configurations:"
swDoc.Visible = False
On Error GoTo SEEMEAGAIN
For i = 0 To UBound(swConfigs)
swDoc.ShowConfiguration2 swConfigs(i)
'Debug.Print swConfigs(i)
Set swFeat = swDoc.FirstFeature
bHadErr = False
errCnt = 0
While Not swFeat Is Nothing
If swFeat.GetErrorCode <> swFeatureErrorNone Then
bHadErr = True
errCnt = errCnt + 1
End If
Set swFeat = swFeat.GetNextFeature
Wend
If bHadErr Then
sMsg = sMsg & vbCrLf & swConfigs(i) & " - " & errCnt & " error(s)"
End If
'Wait = Timer
'While Timer < Wait + 1
' DoEvents
'Wend
Next i
If Right(sMsg, 1) = ":" Then
MsgBox "No configurations had errors."
Else
MsgBox sMsg
End If
SEEMEAGAIN:
swDoc.Visible = True
End Sub
Dim swApp As SldWorks.SldWorks
Dim swDoc As SldWorks.ModelDoc2
Dim swConfigMgr As SldWorks.ConfigurationManager
Dim swConfig As SldWorks.Configuration
Dim swConfigs As Variant
Dim swFM As SldWorks.FeatureManager
Dim swFeat As SldWorks.Feature
Dim i As Long
Dim sMsg As String
Dim errCnt As Long
Dim bHadErr As Boolean
Dim Delay As Double
Dim Wait As Double
Sub main()
Set swApp = Application.SldWorks
Set swDoc = swApp.ActiveDoc
Set swConfigMgr = swDoc.ConfigurationManager
swConfigs = swDoc.GetConfigurationNames
Set swFM = swDoc.FeatureManager
sMsg = "Errors found in configurations:"
'swDoc.Visible = False
Delay = CDbl(InputBox("How long would you like to display each config. in seconds?"))
On Error GoTo SEEMEAGAIN
For i = 0 To UBound(swConfigs)
swDoc.ShowConfiguration2 swConfigs(i)
Wait = Timer
While Timer < Wait + Delay
DoEvents
Wend
'Debug.Print swConfigs(i)
Set swFeat = swDoc.FirstFeature
bHadErr = False
errCnt = 0
While Not swFeat Is Nothing
If swFeat.GetErrorCode <> swFeatureErrorNone Then
bHadErr = True
errCnt = errCnt + 1
End If
Set swFeat = swFeat.GetNextFeature
Wend
If bHadErr Then
sMsg = sMsg & vbCrLf & swConfigs(i) & " - " & errCnt & " error(s)"
End If
'Wait = Timer
'While Timer < Wait + 1
' DoEvents
'Wend
Next i
If Right(sMsg, 1) = ":" Then
MsgBox "No configurations had errors."
Else
MsgBox sMsg
End If
SEEMEAGAIN:
'swDoc.Visible = True
End Sub
Tobin1 said:You should finish it and post it.