Hi,
I intend to procure the minimum distance between two cylinders as parts. I also want the closest points. Have created a form in Visual Basic. Howerver, I am receiving the error
A first chance exception of type 'System.Runtime.InteropServices.COMException' occurred in mscorlib.dll Additional information: Operation unavailable (Exception from HRESULT: 0x800401E3 (MK_E_UNAVAILABLE))
The error occurs for the line
distance = _invApp.MeasureTools.GetMinimumDistance(comp_occ1, comp_occ2, InferredTypeEnum.kNoInference, InferredTypeEnum.kNoInference, cont)
Interestingly, the code does not result in an errror when I give just 2 parameters.
Autodesk Inventor 2014
Visual Studio Express 2013
Please help.
Complete code:
Private Sub ProxSelect2_Click(sender As Object, e As EventArgs) Handles ProxSelect2.Click Dim check_doc As Boolean = True CheckDocument(check_doc) Debug.Print(check_doc) If (Not check_doc) Then Return End If Dim asmDoc As AssemblyDocument asmDoc = _invApp.ActiveDocument If asmDoc.SelectSet.Count <> 2 Then MsgBox("Need to select two parts") Return End If Dim SelSet As SelectSet SelSet = asmDoc.SelectSet Dim comp_occ1 As ComponentOccurrence Dim comp_occ2 As ComponentOccurrence comp_occ1 = SelSet.Item(1) comp_occ2 = SelSet.Item(2) 'Dim vContext As Object = Nothing Dim cont As NameValueMap = Nothing Dim distance As Double distance = _invApp.MeasureTools.GetMinimumDistance(comp_occ1, comp_occ2, InferredTypeEnum.kNoInference, InferredTypeEnum.kNoInference, cont) MsgBox("Distance=" & distance * 10) If Not cont.Item("IntersectionFound") Then Debug.Print(cont.Item("ClosestPointOne").X) Debug.Print(cont.Item("ClosestPointOne").Y) Debug.Print(cont.Item("ClosestPointOne").Z) Debug.Print(cont.Item("ClosestPointTwo").X) Debug.Print(cont.Item("ClosestPointTwo").Y) Debug.Print(cont.Item("ClosestPointTwo").Z) End If Return Try Catch ex As Exception MsgBox(ex.ToString()) MsgBox("SomeError") Return End Try End Sub
Solved! Go to Solution.
Solved by Vladimir.Ananyev. Go to Solution.
You should create NameValueMap object prior to use it as an argument:
Dim cont As NameValueMap = invApp.TransientObjects.CreateNameValueMap
cheers,
Dear Sir,
Thank you for your reply.
I corrected the code as suggested. However, I am still getting the same error.
The entire code is below for your reference. Please help me out. I have been stuck with this problem for long.
Imports System Imports System.Type Imports System.Activator Imports System.Runtime.InteropServices Imports Inventor Public Class Form1 Dim _invApp As Inventor.Application Dim _started As Boolean = False Public Sub New() ' This call is required by the designer. InitializeComponent() ' Add any initialization after the InitializeComponent() call. Try _invApp = Marshal.GetActiveObject("Inventor.Application") Catch ex As Exception Try Dim invAppType As Type = GetTypeFromProgID("Inventor.Application") _invApp = CreateInstance(invAppType) _invApp.Visible = True _started = True Catch ex2 As Exception MsgBox(ex2.ToString()) MsgBox("Unable to get or start Inventor") End Try End Try End Sub Private Sub Form1_FormClosed(ByVal sender As Object, ByVal e As FormClosedEventArgs) If _started Then _invApp.Quit() End If _invApp = Nothing End Sub Public Sub CheckDocument(Optional ByRef check_doc As Boolean = True) Debug.Print("No of Documents" & _invApp.Documents.Count) If _invApp.Documents.Count = 0 Then MsgBox("Need to open an Assembly Document") check_doc = False Return End If If _invApp.ActiveDocument.DocumentType <> DocumentTypeEnum.kAssemblyDocumentObject Then MsgBox("Need to have an Assembly document active") check_doc = False Return End If check_doc = True End Sub Private Sub VerifySystem_Click(ByVal sender As Object, ByVal e As EventArgs) Handles VerifySystem.Click Dim check_doc As Boolean CheckDocument(check_doc) If (check_doc) Then MsgBox("System Stable. Proceed") Return End If End Sub Private Sub ProxSelect2_Click(ByVal sender As Object, ByVal e As EventArgs) Handles ProxSelect2.Click Dim check_doc As Boolean = True CheckDocument(check_doc) Debug.Print(check_doc) If (Not check_doc) Then Return End If Dim asmDoc As AssemblyDocument asmDoc = _invApp.ActiveDocument If asmDoc.SelectSet.Count <> 2 Then MsgBox("Need to select two parts") Return End If Dim SelSet As SelectSet SelSet = asmDoc.SelectSet Dim comp_occ1 As ComponentOccurrence Dim comp_occ2 As ComponentOccurrence comp_occ1 = SelSet.Item(1) comp_occ2 = SelSet.Item(2) 'Dim vContext As Object = Nothing 'Dim cont As NameValueMap = Nothing Dim cont As NameValueMap = _invApp.TransientObjects.CreateNameValueMap Dim distance As Double 'distance = _invApp.MeasureTools.GetMinimumDistance(comp_occ1, comp_occ2, InferredTypeEnum.kNoInference, InferredTypeEnum.kNoInference, cont) distance = _invApp.MeasureTools.GetMinimumDistance(comp_occ1, comp_occ2) MsgBox("Distance=" & distance * 10) If Not cont.Item("IntersectionFound") Then Debug.Print(cont.Item("ClosestPointOne").X) Debug.Print(cont.Item("ClosestPointOne").Y) Debug.Print(cont.Item("ClosestPointOne").Z) Debug.Print(cont.Item("ClosestPointTwo").X) Debug.Print(cont.Item("ClosestPointTwo").Y) Debug.Print(cont.Item("ClosestPointTwo").Z) End If Return Try Catch ex As Exception MsgBox(ex.ToString()) MsgBox("SomeError") Return End Try End Sub End Class
You should calculate distance using
distance = _invApp.MeasureTools.GetMinimumDistance( _ comp_occ1, comp_occ2, _ InferredTypeEnum.kNoInference, _ InferredTypeEnum.kNoInference, _ cont)
then cont object will be filled with values.
Here is quick VBA test that works for me.
Private Sub GetClosestPoints() Dim asmDoc As AssemblyDocument Set asmDoc = ThisApplication.ActiveDocument Dim oOccs As ComponentOccurrences Set oOccs = asmDoc.ComponentDefinition.Occurrences Dim comp_occ1 As ComponentOccurrence Dim comp_occ2 As ComponentOccurrence Set comp_occ1 = oOccs.Item(1) Set comp_occ2 = oOccs.Item(2) Dim cont As NameValueMap Set cont = ThisApplication.TransientObjects.CreateNameValueMap Dim distance As Double distance = ThisApplication.MeasureTools.GetMinimumDistance( _ comp_occ1, comp_occ2, _ InferredTypeEnum.kNoInference, _ InferredTypeEnum.kNoInference, _ cont) MsgBox ("Distance=" & distance * 10) If Not cont.Item("IntersectionFound") Then Debug.Print ("Point 1") With cont.Item("ClosestPointOne") Debug.Print (.x) Debug.Print (.y) Debug.Print (.Z) End With Debug.Print ("Point 2") With cont.Item("ClosestPointTwo") Debug.Print (.x) Debug.Print (.y) Debug.Print (.Z) End With End If Dim Intersection As Boolean Intersection = cont.Item("IntersectionFound") Dim P1 As Point Set P1 = cont.Item("ClosestPointOne") Dim P2 As Point Set P2 = cont.Item("ClosestPointTwo") 'proxy objects - FaceProxy, EdgeProxy, VertexProxy Dim oProxy1 As Object Set oProxy1 = cont.Item("ClosestEntityOne") Dim oProxy2 As Object Set oProxy2 = cont.Item("ClosestEntityTwo") End Sub
cheers,
Sir,
Thankyou for the code. The code works fine. However, after few days of trial, it seems that the error is in the Assembly and not in the code. For certain positions of the parts, the code gives an error. Doesn't make sense, though. I am attaching a sample Assembly, please have a look. If we do not change the position of the parts, the codes (both the add-in I created and the Macro you posted) give the same error. However, it doesn't once the parts are moved! Could this be a bug? Is there some restriction on the parts?
The VBA test code used is the same posted in the above reply.
Private Sub GetClosestPoints() Dim asmDoc As AssemblyDocument Set asmDoc = ThisApplication.ActiveDocument Dim oOccs As ComponentOccurrences Set oOccs = asmDoc.ComponentDefinition.Occurrences Dim comp_occ1 As ComponentOccurrence Dim comp_occ2 As ComponentOccurrence Set comp_occ1 = oOccs.Item(1) Set comp_occ2 = oOccs.Item(2) Dim cont As NameValueMap Set cont = ThisApplication.TransientObjects.CreateNameValueMap Dim distance As Double distance = ThisApplication.MeasureTools.GetMinimumDistance( _ comp_occ1, comp_occ2, _ InferredTypeEnum.kNoInference, _ InferredTypeEnum.kNoInference, _ cont) MsgBox ("Distance=" & distance * 10) If Not cont.Item("IntersectionFound") Then Debug.Print ("Point 1") With cont.Item("ClosestPointOne") Debug.Print (.x) Debug.Print (.y) Debug.Print (.Z) End With Debug.Print ("Point 2") With cont.Item("ClosestPointTwo") Debug.Print (.x) Debug.Print (.y) Debug.Print (.Z) End With End If Dim Intersection As Boolean Intersection = cont.Item("IntersectionFound") Dim P1 As Point Set P1 = cont.Item("ClosestPointOne") Dim P2 As Point Set P2 = cont.Item("ClosestPointTwo") 'proxy objects - FaceProxy, EdgeProxy, VertexProxy Dim oProxy1 As Object Set oProxy1 = cont.Item("ClosestEntityOne") Dim oProxy2 As Object Set oProxy2 = cont.Item("ClosestEntityTwo") End Sub
Please advise.
Also, I shifted my codes to form an add-in using the standard add-in template.
Regards,
Saurav Agarwal
Hi Saurav Agarwal
Can you reproduce this effect in another assembly file or this is accidental case?
I played a bit with your assembly and saw the described error. But I failed to reproduce it in new assemblies that contain both your parts – in new assemblies VBA code works fine for any components configurations.
Cheers,
Hi,
I am attaching a fragment of my original project. Please have a look. The said error occurs for all pairs of cylinders when the "default" positional refresentaition is activated. If we move the parts in the master position, few pairs give the error, while others dont. Is there something wrong with the way the parts are being assembled? Please advise.
Inventor version: 2014 Student Edition
Regards,
Saurav Agarwal
If case when GetMinimumDistance(comp1,comp2, , ,context) method fails you may apply the alternative approach. GetMinimumDistance method works fine with two FaceProxy objects that represent component’s faces in the assembly context. You may Iterate faces collections in both components and find closest faces (and closest points as well). You may filter faces by their geometry, e.g. taking into account cylinder faces only.
The sample below calculates this distance and finds closest points for the side cylinder faces in components 2 and 5 in the BotAssembly.iam in the situation when the simple method fails.
Sub GetClosestPoints_4() Dim oAssyDoc As AssemblyDocument Set oAssyDoc = ThisApplication.ActiveDocument Dim oOcc1 As ComponentOccurrence Set oOcc1 = oAssyDoc.ComponentDefinition.Occurrences.Item(2) Dim oOcc2 As ComponentOccurrence Set oOcc2 = oAssyDoc.ComponentDefinition.Occurrences.Item(5) 'face proxy object from the first component Dim oPartDef1 As PartComponentDefinition Set oPartDef1 = oOcc1.Definition Dim oFace1 As Face ' Set oFace1 = oPartDef1.SurfaceBodies.Item(1).Faces.Item(1) Set oFace1 = oPartDef1.features.ExtrudeFeatures.Item(1).SideFaces(1) Dim oFaceProxy1 As FaceProxy Set oFaceProxy1 = Nothing Call oOcc1.CreateGeometryProxy(oFace1, oFaceProxy1) 'face proxy object from another component Dim oPartDef2 As PartComponentDefinition Set oPartDef2 = oOcc2.Definition Dim oFace2 As Face ' Set oFace2 = oPartDef2.SurfaceBodies.Item(1).Faces.Item(1) Set oFace2 = oPartDef2.features.ExtrudeFeatures.Item(1).SideFaces(1) Dim oFaceProxy2 As FaceProxy Set oFaceProxy2 = Nothing Call oOcc2.CreateGeometryProxy(oFace2, oFaceProxy2) Dim context As NameValueMap Set context = ThisApplication.TransientObjects.CreateNameValueMap Dim distance As Double distance = ThisApplication.MeasureTools.GetMinimumDistance( _ oFaceProxy1, oFaceProxy2, _ InferredTypeEnum.kNoInference, _ InferredTypeEnum.kNoInference, _ context) MsgBox ("Distance=" & distance * 10) Dim Intersection As Boolean Intersection = context.Item("IntersectionFound") If Not Intersection Then Dim P1 As Point Set P1 = context.Item("ClosestPointOne") Dim P2 As Point Set P2 = context.Item("ClosestPointTwo") 'temporary debug print Debug.Print ("Point 1") With P1 Debug.Print (.x) Debug.Print (.y) Debug.Print (.Z) End With Debug.Print ("Point 2") With P2 Debug.Print (.x) Debug.Print (.y) Debug.Print (.Z) End With '------------------------ End If End Sub
Hope this workaround could help you.
Cheers,
You may access all faces via PartComponentDefinition.SurfaceBodies.Item(1).Faces collection. Also you may get references to faces from features as it was shown in my previous post. Filtering faces by geometry and/or area could enhance performance. SurfaceType property of the Face object returns SurfaceTypeEnum constant that allows filter all cylindrical faces:
Sub AllCylinderFaces() Dim oDoc As PartDocument Set oDoc = ThisApplication.ActiveDocument Dim oDef As PartComponentDefinition Set oDef = oDoc.ComponentDefinition Dim oBody As SurfaceBody Dim oFace As Face For Each oBody In oDef.SurfaceBodies For Each oFace In oBody.Faces If oFace.SurfaceType = kCylinderSurface Then 'Do something useful here Debug.Print "Area = " & oFace.Evaluator.Area ' cm^2 End If Next Next End Sub
I’ve logged this case in our database.
Thank you for the sample assemblies!