Untitled diff

作成日 差分は期限切れになりません
11 削除
169
8 追加
167
Sub main()
Sub main()
Dim m_Inventor As Inventor.Application
m_Inventor = System.Runtime.InteropServices.Marshal.GetActiveObject("Inventor.Application")

If System.IO.File.Exists("c:\Temp\Bohrungen.txt") Then
If System.IO.File.Exists("c:\Temp\Bohrungen.txt") Then
System.IO.File.Delete("c:\Temp\Bohrungen.txt")
System.IO.File.Delete("c:\Temp\Bohrungen.txt")
End If
End If




Dim file As System.IO.StreamWriter
Dim file As System.IO.StreamWriter
file = My.Computer.FileSystem.OpenTextFileWriter("c:\Temp\Bohrungen.txt", True)
file = My.Computer.FileSystem.OpenTextFileWriter("c:\Temp\Bohrungen.txt", True)


Dim oDoc As AssemblyDocument
Dim oDoc As AssemblyDocument
oDoc = m_Inventor.ActiveDocument
oDoc = ThisApplication.ActiveDocument


Dim oCompdef As AssemblyComponentDefinition
Dim oCompdef As AssemblyComponentDefinition
oCompdef = oDoc.ComponentDefinition
oCompdef = oDoc.ComponentDefinition


Dim oBody1 As SurfaceBody
Dim oBody1 As SurfaceBody
Dim oBody2 As SurfaceBody
Dim oBody2 As SurfaceBody


oBody1 = m_Inventor.CommandManager.Pick(SelectionFilterEnum.kPartBodyFilter, "Select first body")
oBody1 = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kPartBodyFilter, "Select first body")
oBody2 = m_Inventor.CommandManager.Pick(SelectionFilterEnum.kPartBodyFilter, "Select a body to compare")
oBody2 = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kPartBodyFilter, "Select a body to compare")


Dim oFace1 As Face
Dim oFace1 As Face
Dim oFace2 As Face
Dim oFace2 As Face
Dim oFaceColl1 As ObjectCollection
Dim oFaceColl1 As ObjectCollection
oFaceColl1 = m_Inventor.TransientObjects.CreateObjectCollection()
oFaceColl1 = ThisApplication.TransientObjects.CreateObjectCollection()
Dim oFaceColl2 As ObjectCollection
Dim oFaceColl2 As ObjectCollection
oFaceColl2 = m_Inventor.TransientObjects.CreateObjectCollection()
oFaceColl2 = ThisApplication.TransientObjects.CreateObjectCollection()
Dim oAxis1 As WorkAxis
Dim oAxis1 As WorkAxis
Dim oAxisColl1 As ObjectCollection
Dim oAxisColl1 As ObjectCollection
oAxisColl1 = m_Inventor.TransientObjects.CreateObjectCollection()
oAxisColl1 = ThisApplication.TransientObjects.CreateObjectCollection()
Dim oAxis2 As WorkAxis
Dim oAxis2 As WorkAxis
Dim oAxisColl2 As ObjectCollection
Dim oAxisColl2 As ObjectCollection
oAxisColl2 = m_Inventor.TransientObjects.CreateObjectCollection()
oAxisColl2 = ThisApplication.TransientObjects.CreateObjectCollection()


For Each oFace1 In oBody1.Faces
For Each oFace1 In oBody1.Faces
If oFace1.SurfaceType = SurfaceTypeEnum.kCylinderSurface Then
If oFace1.SurfaceType = SurfaceTypeEnum.kCylinderSurface Then
oAxis1 = oCompdef.WorkAxes.AddFixed(oFace1.Geometry.BasePoint, oFace1.Geometry.AxisVector)
oAxis1 = oCompdef.WorkAxes.AddFixed(oFace1.Geometry.BasePoint, oFace1.Geometry.AxisVector)


If IsAxisDuplicate(oAxis1, oAxisColl1) = False Then
If IsAxisDuplicate(oAxis1, oAxisColl1) = False Then


oAxisColl1.Add(oAxis1)
oAxisColl1.Add(oAxis1)
oFaceColl1.Add(oFace1)
oFaceColl1.Add(oFace1)


Else
Else
oAxis1.Delete()
oAxis1.Delete()
End If
End If
End If
End If
Next
Next


For Each oFace2 In oBody2.Faces
For Each oFace2 In oBody2.Faces
If oFace2.SurfaceType = SurfaceTypeEnum.kCylinderSurface Then
If oFace2.SurfaceType = SurfaceTypeEnum.kCylinderSurface Then
oAxis2 = oCompdef.WorkAxes.AddFixed(oFace2.Geometry.BasePoint, oFace2.Geometry.AxisVector)
oAxis2 = oCompdef.WorkAxes.AddFixed(oFace2.Geometry.BasePoint, oFace2.Geometry.AxisVector)


If IsAxisDuplicate(oAxis2, oAxisColl2) = False Then
If IsAxisDuplicate(oAxis2, oAxisColl2) = False Then


oAxisColl2.Add(oAxis2)
oAxisColl2.Add(oAxis2)
oFaceColl2.Add(oFace2)
oFaceColl2.Add(oFace2)


Else
Else
oAxis2.Delete()
oAxis2.Delete()
End If
End If
End If
End If
Next
Next


For i As Integer = 1 To oAxisColl1.Count
For i As Integer = 1 To oAxisColl1.Count
oAxis1 = oAxisColl1.Item(i)
oAxis1 = oAxisColl1.Item(i)
Dim j As Integer = 0
Dim j As Integer = 0
j = CompareAlignment(oAxis1, oAxisColl2)
j = CompareAlignment(oAxis1, oAxisColl2)
If j > 0 Then
If j > 0 Then
oFace1 = oFaceColl1.Item(i)
oFace1 = oFaceColl1.Item(i)
oFace2 = oFaceColl2.Item(j)
oFace2 = oFaceColl2.Item(j)
CompareFace(oFace1, oFace2, file)
CompareFace(oFace1, oFace2, file)
oFace1.AttributeSets.Add("Aligned")
oFace1.AttributeSets.Add("Aligned")
oFace2.AttributeSets.Add("Aligned")
oFace2.AttributeSets.Add("Aligned")
End If
End If
Next
Next


For Each oFace1 In oFaceColl1
For Each oFace1 In oFaceColl1
If oFace1.AttributeSets.Count = 0 Then
If oFace1.AttributeSets.Count = 0 Then
Dim oHoleFeature As HoleFeature
Dim oHoleFeature As HoleFeature
oHoleFeature = oFace1.CreatedByFeature
oHoleFeature = oFace1.CreatedByFeature


Dim dia As Double
Dim dia As Double
dia = oHoleFeature.HoleDiameter.Value * 10 ' Converting cm to mm
dia = oHoleFeature.HoleDiameter.Value * 10 ' Converting cm to mm
file.WriteLine("Hole diameter of plate 1 = " & "Ø" & dia & " - " & oHoleFeature.ExtendedName & " => misaligned")
file.WriteLine("Hole diameter of plate 1 = " & "Ø" & dia & " - " & oHoleFeature.ExtendedName & " => misaligned")
End If
End If
Next
Next


For Each oFace2 In oFaceColl2
For Each oFace2 In oFaceColl2
If oFace2.AttributeSets.Count = 0 Then
If oFace2.AttributeSets.Count = 0 Then
Dim oHoleFeature As HoleFeature
Dim oHoleFeature As HoleFeature
oHoleFeature = oFace2.CreatedByFeature
oHoleFeature = oFace2.CreatedByFeature


Dim dia As Double
Dim dia As Double
dia = oHoleFeature.HoleDiameter.Value * 10 ' Converting cm to mm
dia = oHoleFeature.HoleDiameter.Value * 10 ' Converting cm to mm
file.WriteLine("Hole diameter of plate 2 = " & "Ø" & dia & " - " & oHoleFeature.ExtendedName & " => misaligned")
file.WriteLine("Hole diameter of plate 2 = " & "Ø" & dia & " - " & oHoleFeature.ExtendedName & " => misaligned")
End If
End If
Next
Next


CleanAxis(oAxisColl1)
CleanAxis(oAxisColl1)
CleanAxis(oAxisColl2)
CleanAxis(oAxisColl2)


m_Inventor.StatusBarText = "Ausgabe in c:\Temp\Bohrungen.txt"
ThisApplication.StatusBarText = "Ausgabe in c:\Temp\Bohrungen.txt"
file.Close()
file.Close()
Process.Start("c:\Temp\Bohrungen.txt")
Process.Start("c:\Temp\Bohrungen.txt")


End Sub
End Sub
Public Sub CleanAxis(ByVal oAxisColl As ObjectCollection)
Public Sub CleanAxis(ByVal oAxisColl As ObjectCollection)
For Each oAxis As WorkAxis In oAxisColl
For Each oAxis As WorkAxis In oAxisColl
oAxis.Delete()
oAxis.Delete()
Next
Next
End Sub
End Sub
Public Sub CompareFace(ByVal oFace1 As Face, ByVal oFace2 As Face, ByVal File As System.IO.StreamWriter)
Public Sub CompareFace(ByVal oFace1 As Face, ByVal oFace2 As Face, ByVal File As System.IO.StreamWriter)


Dim oHoleFeature1 As HoleFeature
Dim oHoleFeature1 As HoleFeature
oHoleFeature1 = oFace1.CreatedByFeature
oHoleFeature1 = oFace1.CreatedByFeature


Dim dia1 As Double
Dim dia1 As Double
dia1 = oHoleFeature1.HoleDiameter.Value
dia1 = oHoleFeature1.HoleDiameter.Value
dia1 = dia1 * 10 'Converting cm to mm
dia1 = dia1 * 10 'Converting cm to mm


Dim oHoleFeature2 As HoleFeature
Dim oHoleFeature2 As HoleFeature
oHoleFeature2 = oFace2.CreatedByFeature
oHoleFeature2 = oFace2.CreatedByFeature


Dim dia2 As Double
Dim dia2 As Double
dia2 = oHoleFeature2.HoleDiameter.Value
dia2 = oHoleFeature2.HoleDiameter.Value
dia2 = dia2 * 10 'Converting cm to mm
dia2 = dia2 * 10 'Converting cm to mm


If Math.Round(dia1, 4) = Math.Round(dia2, 4) Then
If Math.Round(dia1, 4) = Math.Round(dia2, 4) Then
Debug.Print("Hole diameter of plate 1 = " & dia1 & " compared with Hole diameter of plate 2 = " & dia2 & " => OK - Default")
Debug.Print("Hole diameter of plate 1 = " & dia1 & " compared with Hole diameter of plate 2 = " & dia2 & " => OK - Default")
file.WriteLine("Hole diameter of plate 1 = " & "Ø" & dia1 & " - " & oHoleFeature1.ExtendedName & " compared with Hole diameter of plate 2 = " & "Ø" & dia2 & " - " & oHoleFeature2.ExtendedName & " => OK - Default")
file.WriteLine("Hole diameter of plate 1 = " & "Ø" & dia1 & " - " & oHoleFeature1.ExtendedName & " compared with Hole diameter of plate 2 = " & "Ø" & dia2 & " - " & oHoleFeature2.ExtendedName & " => OK - Default")
ElseIf Math.Round(dia1, 4) >= Math.Round(dia2, 4) And Math.Round(dia1, 4) <= Math.Round(dia2, 4) + 0.5 Then
ElseIf Math.Round(dia1, 4) >= Math.Round(dia2, 4) And Math.Round(dia1, 4) <= Math.Round(dia2, 4) + 0.5 Then
Debug.Print("Hole diameter of plate 1 = " & dia1 & " compared with Hole diameter of plate 2 = " & dia2 & " => OK - Special Type")
Debug.Print("Hole diameter of plate 1 = " & dia1 & " compared with Hole diameter of plate 2 = " & dia2 & " => OK - Special Type")
file.WriteLine("Hole diameter of plate 1 = " & "Ø" & dia1 & " - " & oHoleFeature1.ExtendedName & " compared with Hole diameter of plate 2 = " & "Ø" & dia2 & " - " & oHoleFeature2.ExtendedName & " => OK - Special Type")
file.WriteLine("Hole diameter of plate 1 = " & "Ø" & dia1 & " - " & oHoleFeature1.ExtendedName & " compared with Hole diameter of plate 2 = " & "Ø" & dia2 & " - " & oHoleFeature2.ExtendedName & " => OK - Special Type")
Else
Else
Debug.Print("Hole diameter of plate 1 = " & dia1 & " compared with Hole diameter of plate 2 = " & dia2 & " => Not OK")
Debug.Print("Hole diameter of plate 1 = " & dia1 & " compared with Hole diameter of plate 2 = " & dia2 & " => Not OK")
file.WriteLine("Hole diameter of plate 1 = " & "Ø" & dia1 & " - " & oHoleFeature1.ExtendedName & " compared with Hole diameter of plate 2 = " & "Ø" & dia2 & " - " & oHoleFeature2.ExtendedName & " => Not OK")
file.WriteLine("Hole diameter of plate 1 = " & "Ø" & dia1 & " - " & oHoleFeature1.ExtendedName & " compared with Hole diameter of plate 2 = " & "Ø" & dia2 & " - " & oHoleFeature2.ExtendedName & " => Not OK")
End If
End If
End Sub
End Sub
Public Function CompareAlignment(ByVal oAxis As WorkAxis, ByVal oAxisCollection As ObjectCollection) As Integer
Public Function CompareAlignment(ByVal oAxis As WorkAxis, ByVal oAxisCollection As ObjectCollection) As Integer
For i As Integer = 1 To oAxisCollection.Count
For i As Integer = 1 To oAxisCollection.Count
Dim axis As WorkAxis
Dim axis As WorkAxis
axis = oAxisCollection.Item(i)
axis = oAxisCollection.Item(i)
If oAxis.Line.IsColinearTo(axis.Line) Then
If oAxis.Line.IsColinearTo(axis.Line) Then
Return i
Return i
Exit Function
Exit Function
End If
End If
Next
Next


Return 0
Return 0
End Function
End Function


Public Function IsAxisDuplicate(ByVal oAxis As WorkAxis, ByVal oAxisColl As ObjectCollection) As Boolean
Public Function IsAxisDuplicate(ByVal oAxis As WorkAxis, ByVal oAxisColl As ObjectCollection) As Boolean
If oAxisColl.Count > 0 Then
If oAxisColl.Count > 0 Then
For i As Integer = 1 To oAxisColl.Count
For i As Integer = 1 To oAxisColl.Count
Dim Axis As WorkAxis
Dim Axis As WorkAxis
Axis = oAxisColl.Item(i)
Axis = oAxisColl.Item(i)
If Axis.Line.IsColinearTo(oAxis.Line) Then
If Axis.Line.IsColinearTo(oAxis.Line) Then
Return True
Return True
End If
End If
Next
Next
Return False
Return False
Else
Else
Return False
Return False
End If
End If
End Function
End Function