Option Strict Off
Option Explicit On
Module Module1
    Dim objApp As SolidEdgeFramework.Application
    Dim objTradSEDoc As SolidEdgeAssembly.AssemblyDocument
    'Dim objSyncSEDoc As SolidEdgeAssemblySync.AssemblyDocument
    Dim objSEDoc As Object
    Dim Clean As Boolean

    Dim bFoundOriginallySuppressed As Boolean


    Public Sub Main()

        Dim bSuppressed, Sync As Boolean
        Dim DocFullName As String
        Dim DocName As String
        Dim Path As String
        Dim i As Integer

        'Get the application
        On Error Resume Next
        objApp = GetObject(, "SolidEdge.Application")
        If Err.Number Then
            MsgBox("Cannot attach to Solid Edge", MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "Error")
            Exit Sub
        End If

        'Get the active document
        objSEDoc = Nothing
        Sync = False
        Clean = True
        'If objApp.ActiveDocumentType = SolidEdgeFramework.DocumentTypeConstants.igSyncAssemblyDocument Then
        '    Sync = True
        '    objSyncSEDoc = objApp.ActiveDocument
        '    objSEDoc = objSyncSEDoc
        'Else
        '    objTradSEDoc = objApp.ActiveDocument
        '    objSEDoc = objTradSEDoc
        'End If
        objTradSEDoc = objApp.ActiveDocument
        objSEDoc = objTradSEDoc


        'objSEDoc = objApp.ActiveDocument

        'Flag used to format result test file
        bFoundOriginallySuppressed = False

        DocName = objSEDoc.Name
        DocFullName = objSEDoc.FullName
        i = InStr(1, DocFullName, DocName, CompareMethod.Text)
        Path = DocFullName.Substring(0, i - 2)

        FileOpen(1, Path & "\" & DocName & ".txt", OpenMode.Output)

        'Suppress all sick constraints
        bSuppressed = SuppressSickConstraints()

        If bSuppressed Then
            'Analyze the model
            Process()
            objApp.StatusBar = "Diagnosis completed. See the text file in " & Path & " for result."
            'MsgBox("Diagnosis completed. See the text file in c:\temp for result.", MsgBoxStyle.OkOnly, "Asm Model Diagnosis")
        End If

        If Clean = True Then
            PrintLine(1, "No relationship issues found." & vbCrLf)
            objApp.StatusBar = "Diagnosis completed. No relationship issues found."
            'MsgBox("Diagnosis completed. No relationship issues found.")
        End If

        If Clean = False And bSuppressed = False Then
            objApp.StatusBar = "Diagnosis completed. No relationship issues found. See the text file in " & Path & " for originally suppressed constraints."
            'MsgBox("Diagnosis completed. No relationship issues found. See the text file in c:\temp for originally suppressed constraints.")
        End If

        FileClose(1)

        objSEDoc = Nothing
        objApp = Nothing
    End Sub
	
	
	Public Function SuppressSickConstraints() As Boolean
        Dim obj3DRelationsCollection As Object
		Dim objThisRelation As Object
		
		Dim Cnt3DRelations As Short
		Dim K As Short
		
		Dim bSuppressed As Boolean
		
		On Error Resume Next
		
		'Initialize to false
		SuppressSickConstraints = False
		
        objApp.DelayCompute = True
		
        obj3DRelationsCollection = Nothing
        obj3DRelationsCollection = objSEDoc.Relations3d
        Cnt3DRelations = obj3DRelationsCollection.Count
		
        objThisRelation = Nothing
		
		For K = 1 To Cnt3DRelations
            objThisRelation = obj3DRelationsCollection(K)
			
            bSuppressed = objThisRelation.Suppress
			
			If bSuppressed = False Then
                If objThisRelation.Status = SolidEdgeAssembly.Relation3dStatusConstants.igRelation3dStatusUnsolved Then
                    objThisRelation.Suppress = True

                    'Found at least one sick constraint, return true to trigger analysis
                    SuppressSickConstraints = True
                End If
			Else
				If bFoundOriginallySuppressed = False Then
					'Write out tital for this section
					PrintLine(1, "Originally suppressed:" & vbCrLf)
                    bFoundOriginallySuppressed = True
                    Clean = False
				End If
				
				'Write the originally suppressed to the text file
				OutputResult(objThisRelation)
			End If
			
            objThisRelation = Nothing
		Next 
		
        obj3DRelationsCollection = Nothing
		
        objApp.DelayCompute = False
		
	End Function
	
	Public Sub Process()
		
        Dim objOccurrenceCollection As Object
        Dim objOccurrence As Object
		Dim obj3DRelations As Object
		Dim obj3DRel As Object
		
		Dim CntOccurrences As Short
		Dim Cnt3DRelations As Short
		Dim K As Short
		Dim H As Short
		
		Dim bSuppressed As Boolean
		Dim bFailed As Boolean
		Dim bDoSuppress As Boolean
        Dim bFirstFailed As Boolean

		On Error Resume Next
		
        objOccurrenceCollection = Nothing
        objOccurrenceCollection = objSEDoc.Occurrences
        CntOccurrences = objOccurrenceCollection.Count
		
        objOccurrence = Nothing
        obj3DRelations = Nothing
        obj3DRel = Nothing

        bFirstFailed = True

		For K = 1 To CntOccurrences
            objOccurrence = objOccurrenceCollection(K)
			
            obj3DRelations = objOccurrence.Relations3d
            Cnt3DRelations = obj3DRelations.Count
			
			'First unsuppress all constraints on this occurrence
			ProcessConstraintsOnOcc(objOccurrence, False)
			
			'Check the result of the compute
			bFailed = SolveFailed
			
			If bFailed = True Then
				'At least one constraint on this occurrence is causing failure(s),
				'analyze each one separately.
				
				'First re-suppress all sick constraints on this occurrence
				ProcessConstraintsOnOcc(objOccurrence, True)
				
				'Now unsuppress and compute one by one
				For H = 1 To Cnt3DRelations
					obj3DRel = obj3DRelations(H)
					
                    bSuppressed = obj3DRel.Suppress
					If bSuppressed = True Then
                        obj3DRel.Suppress = False 'Unsuppress and compute
						
						bFailed = SolveFailed 'Analyze the compute result
						If bFailed = True Then
							'This one causes failure, keep it suppressed
                            obj3DRel.Suppress = True
							
							If bFoundOriginallySuppressed = True Then
								'Write out tital for this section
                                bFoundOriginallySuppressed = False
                                Clean = False
                            End If

                            'Write result to the text file
                            If bFirstFailed Then
                                PrintLine(1, "-------------------------" & vbCrLf)
                                PrintLine(1, "Suppressed by AsmRelDoctor:" & vbCrLf)
                                bFirstFailed = False
                            End If
                            OutputResult(obj3DRel)
						End If
					End If
					
                    obj3DRel = Nothing
				Next 
			End If
			
            objOccurrence = Nothing
            obj3DRelations = Nothing
		Next 
		
        objOccurrenceCollection = Nothing
	End Sub
	
	Public Function ProcessConstraintsOnOcc(ByRef objOcc As Object, ByRef bDoSuppress As Boolean) As Boolean
		'This function suppress sick constraints or unsuppress constraints on the given occurrence.
		'Compute will be done at the end.
		Dim obj3DRelations As Object
		Dim obj3DRel As Object
		
		Dim Cnt3DRelations As Short
		Dim H As Short
		
		Dim bSuppressed As Boolean
		
        objApp.DelayCompute = True
		
        obj3DRelations = Nothing
        obj3DRelations = objOcc.Relations3d
        Cnt3DRelations = obj3DRelations.Count
		
        obj3DRel = Nothing
		
		For H = 1 To Cnt3DRelations
			obj3DRel = obj3DRelations(H)
			
			If bDoSuppress Then 'Suppress
                bSuppressed = obj3DRel.Suppress
				If bSuppressed = False Then
                    If obj3DRel.Status = SolidEdgeAssembly.Relation3dStatusConstants.igRelation3dStatusUnsolved Then
                        obj3DRel.Suppress = True
                    End If
				End If
			Else 'Unsuppress
                bSuppressed = obj3DRel.Suppress
				If bSuppressed = True Then
                    obj3DRel.Suppress = False
				End If
			End If
			
            obj3DRel = Nothing
		Next 
		
        objApp.DelayCompute = False
		
	End Function
	Public Function SolveFailed() As Boolean
		'This function look through constraints in the document. It returns True if
		'one failed constraint is found. Otherwise it returns False
		
        Dim objOccurrenceCollection As Object
        Dim objOccurrence As Object
		Dim obj3DRelations As Object
		Dim obj3DRel As Object
		
		Dim CntOccurrences As Short
		Dim Cnt3DRelations As Short
		Dim K As Short
		Dim H As Short
		
		Dim bSuppressed As Boolean
		Dim bNoFailure As Boolean
		
		On Error Resume Next
		
        objOccurrenceCollection = Nothing
        objOccurrenceCollection = objSEDoc.Occurrences
        CntOccurrences = objOccurrenceCollection.Count
		
        objOccurrence = Nothing
        obj3DRelations = Nothing
        obj3DRel = Nothing
		
		SolveFailed = False
		
		For K = 1 To CntOccurrences
            objOccurrence = objOccurrenceCollection.Item(K)
            obj3DRelations = objOccurrence.Relations3d
            Cnt3DRelations = obj3DRelations.Count
			
			For H = 1 To Cnt3DRelations
				obj3DRel = obj3DRelations(H)
				
                bSuppressed = obj3DRel.Suppress
				If bSuppressed = False Then
                    If obj3DRel.Status = SolidEdgeAssembly.Relation3dStatusConstants.igRelation3dStatusUnsolved Then
                        'Found a failed relationship, stop looping and return true
                        SolveFailed = True
                        Exit Function
                    End If
				End If
				
                obj3DRel = Nothing
			Next 
			
            obj3DRelations = Nothing
            objOccurrence = Nothing
		Next 
	End Function
	
	Public Function OutputResult(ByRef obj3DRel As Object) As Boolean
		
		Dim RelationType As String
		Dim Occ1Name As String
		Dim Occ2Name As String
		Dim OutputString As String
		
		Occ1Name = ""
		Occ2Name = ""
        RelationType = ""
		On Error Resume Next
		
		'GET THE RELATIONSHIP TYPE SO WE CAN WRITE TO COMMENTS IF IT IS FAILED
        If obj3DRel.Type = SolidEdgeConstants.ObjectType.igAngularRelation3d Then
            RelationType = "Angular"
        ElseIf obj3DRel.Type = SolidEdgeConstants.ObjectType.igAxialRelation3d Then
            RelationType = "Axial"
        ElseIf obj3DRel.Type = SolidEdgeConstants.ObjectType.igGroundRelation3d Then
            RelationType = "Ground"
        ElseIf obj3DRel.Type = SolidEdgeConstants.ObjectType.igPlanarRelation3d Then
            If obj3DRel.NormalsAligned = False Then
                RelationType = "Mate"
            ElseIf obj3DRel.NormalsAligned = True Then
                RelationType = "Align"
            End If
        ElseIf obj3DRel.Type = SolidEdgeConstants.ObjectType.igPointRelation3d Then
            RelationType = "Point"
        ElseIf obj3DRel.Type = SolidEdgeConstants.ObjectType.igTangentRelation3d Then
            RelationType = "Tangent"
        End If
		
		If RelationType = "Ground" Then
            Occ1Name = obj3DRel.Occurrence.Name
		Else
            Occ1Name = obj3DRel.Occurrence1.Name
            Occ2Name = obj3DRel.Occurrence2.Name
		End If
		
		OutputString = Occ1Name & " / " & Occ2Name & " - " & RelationType & vbCrLf
        PrintLine(1, OutputString)
        Clean = False
		OutputString = ""
		
	End Function
End Module