Hi All,
I have automated generation of imates with user interaction for some series of Parts. One part is attached here. If I don't include MatchList for Composite imates it works fine but Including Matchlist for composite imate gives me Run-time Error '5': Invalid Procedure Call or Argument. Can anybody help me please?
Working on Inventor 2017
Regards,Jitenkumar
Unable to attach form here so sharing a pic
Form - Form_Imate_Creator_FB
Private Sub UserForm_Initialize()
PopCoB_ElmtType
CoB_ElmtType.ListIndex = 0
End Sub
Private Sub PopCoB_ElmtType()
CoB_ElmtType.Clear
'Initialise Raw Material Form Combo Box
CoB_ElmtType.AddItem "8 Port Block"
CoB_ElmtType.AddItem "4 Port Block"
CoB_ElmtType.AddItem "M12 5Pin Conn Male"
CoB_ElmtType.AddItem "M12 4Pin Conn Male"
CoB_ElmtType.AddItem "M12 4Pin Conn Female"
CoB_ElmtType.AddItem "M12 5Pin Conn Female"
End Sub
Private Sub CoBu_Exit_Click()
FBiMC.Kill = True
Unload Me
End Sub
Private Sub CoBu_Apply_Click()
FBiMC.ElmtType = CoB_ElmtType.Value
Unload Me
End SubMain Module
Public Type FBiMCObj_Datatype 'used in Cls_GetSelObj_FB as well hence public
IMObject As Object
IMBiasPoint As Point
End Type
Public Type FBiMC_DataType
Doc As Document
ElmtType As String
Kill As Boolean
Esc As Boolean
End Type
Public FBiMC As FBiMC_DataType
Dim N_iports As Integer
Sub Imate_Creator_FB()
Set FBiMC.Doc = ThisApplication.ActiveDocument
If FBiMC.Doc.DocumentType = kPartDocumentObject Xor kAssemblyDocumentObject Then
'Pass
Else
MsgBox "File Type Not Compatible. Please Use a Part or an Assembly File"
Exit Sub
End If
FBiMC.Kill = False
FBiMC.Esc = False
Form_Imate_Creator_FB.Show
If FBiMC.Kill Then Exit Sub ' just to cut short the calculation time. Create_iMate any way terminates on FBiMC.Kill
CreateiMates FBiMC.Doc, FBiMC.ElmtType
End Sub
Sub CreateiMates(ByRef sDoc As Document, ByVal sElmtType As String)
Dim Compdef As ComponentDefinition
Dim iMateColl As ObjectCollection
Dim CiMateMatchList() As String
Dim Offset As String
Dim mate As iMateDefinition
Dim CMate As CompositeiMateDefinition
Dim a As Integer
Set Compdef = sDoc.ComponentDefinition
Select Case FBiMC.ElmtType
Case "8 Port Block": N_iports = 8
Case "4 Port Block": N_iports = 4
End Select
Set iMateColl = ThisApplication.TransientObjects.CreateObjectCollection
Select Case FBiMC.ElmtType
Case "8 Port Block", "4 Port Block"
Set mate = Create_iMate(sDoc, sElmtType, "Port-A M12 6P Male", "M12 6P Insert", "Insert", "0 in", True)
If FBiMC.Kill = False Then iMateColl.Add mate Else Exit Sub
Set mate = Create_iMate(sDoc, sElmtType, "Port-A M12 6P Male", "M12 6P Orientation", "Angle", "180 deg", True)
If FBiMC.Kill = False Then iMateColl.Add mate Else Exit Sub
CiMateMatchList = Create_CiMatchList("Port-A M12 6P Male", sElmtType)
'Debug.Print UBound(CiMateMatchList, 1) & CiMateMatchList(0)
If IsArrayInitialized(CiMateMatchList) Then
Set CMate = Compdef.iMateDefinitions.AddCompositeiMateDefinition(iMateColl, "Port-A M12 6P Male", CiMateMatchList)
Else
Set CMate = Compdef.iMateDefinitions.AddCompositeiMateDefinition(iMateColl, "Port-A M12 6P Male")
End If
iMateColl.Clear
Set mate = Create_iMate(sDoc, sElmtType, "Port-B M12 6P Female", "M12 6P Insert", "Insert", "0 in", True)
If FBiMC.Kill = False Then iMateColl.Add mate Else Exit Sub
Set mate = Create_iMate(sDoc, sElmtType, "Port-B M12 6P Female", "M12 6P Orientation", "Angle", "180 deg", True)
If FBiMC.Kill = False Then iMateColl.Add mate Else Exit Sub
CiMateMatchList = Create_CiMatchList("Port-A M12 6P Female", sElmtType)
If IsArrayInitialized(CiMateMatchList) Then
Set CMate = Compdef.iMateDefinitions.AddCompositeiMateDefinition(iMateColl, "Port-A M12 6P Female", CiMateMatchList)
Else
Set CMate = Compdef.iMateDefinitions.AddCompositeiMateDefinition(iMateColl, "Port-A M12 6P Female")
End If
iMateColl.Clear
For a = 0 To N_iports - 1
iMateColl.Clear
Set mate = Create_iMate(sDoc, sElmtType, "Port-" & a & " M12 5P Female", "M12 4P/5P Insert", "Insert", "0.001 in", True)
If FBiMC.Kill = False Then iMateColl.Add mate Else Exit Sub
Set mate = Create_iMate(sDoc, sElmtType, "Port-" & a & " M12 5P Female", "M12 4P/5P Orientation", "Angle", "180 deg", True)
If FBiMC.Kill = False Then iMateColl.Add mate Else Exit Sub
CiMateMatchList = Create_CiMatchList("Port-" & a & " M12 5P Female", sElmtType)
If IsArrayInitialized(CiMateMatchList) Then
Set CMate = Compdef.iMateDefinitions.AddCompositeiMateDefinition(iMateColl, "Port-" & a & " M12 5P Female", CiMateMatchList)
Else
Set CMate = Compdef.iMateDefinitions.AddCompositeiMateDefinition(iMateColl, "Port-" & a & " M12 5P Female")
End If
Next a
End Select
End Sub
Function Create_CiMatchList(ByVal f_CiMateName, f_ElmtType As String) As String()
Dim MatchList() As String
Dim a As Integer
Erase MatchList
Select Case f_ElmtType
Case "8 Port Block", "4 Port Block"
Select Case f_CiMateName
Case "Port-A M12 6P Male"
ReDim MatchList(0)
MatchList(0) = "M12 6P Female"
Case "Port-B M12 6P Female"
ReDim MatchList(0)
MatchList(0) = "M12 6P Male"
End Select
For a = 0 To N_iports - 1
If f_CiMateName = "Port-" & a & " M12 6P Female" Then
ReDim MatchList(1)
MatchList(0) = "M12 4P Male"
MatchList(1) = "M12 5P Male"
End If
Next a
Case Else
End Select
Create_CiMatchList = MatchList
End Function
Function Create_MatchList(ByVal f_CiMateName, f_iMateName, f_ElmtType As String) As String()
Dim MatchList() As String
Dim a As Integer
Erase MatchList
Select Case f_ElmtType
Case "8 Port Block", "4 Port Block"
Select Case f_CiMateName
Case "Port-A M12 6P Male"
Select Case f_iMateName
Case "M12 6P Insert"
ReDim MatchList(0)
MatchList(0) = "M12 6P Female Insert"
Case "M12 6P Orientation"
ReDim MatchList(0)
MatchList(0) = "M12 6P Female Orientation"
Case Else
End Select
Case "Port-B M12 6P Female"
Select Case f_iMateName
Case "M12 6P Insert"
ReDim MatchList(0)
MatchList(0) = "M12 6P Male Insert"
Case "M12 6P Orientation"
ReDim MatchList(0)
MatchList(0) = "M12 6P Male Orientation"
Case Else
End Select
End Select
For a = 0 To N_iports - 1
If f_CiMateName = "Port-" & a & " M12 5P Female" Then
Select Case f_iMateName
Case "M12 4P/5P Insert"
ReDim MatchList(1)
MatchList(0) = "M12 4P Male Insert"
MatchList(1) = "M12 5P Male Insert"
Case "M12 4P/5P Orientation"
ReDim MatchList(1)
MatchList(0) = "M12 4P Male Orientation"
MatchList(1) = "M12 5P Male Orientation"
Case Else
End Select
End If
Next a
Case "M12 6Pin Conn"
Select Case f_CiMateName
Case "M12 6P Male"
Select Case f_iMateName
Case "M12 6P Insert"
ReDim MatchList(2)
MatchList(0) = "Port-A M12 6P Female Insert"
MatchList(1) = "Port-B M12 6P Female Insert"
MatchList(2) = "M12 6P Female Insert"
Case "M12 6P Orientation"
ReDim MatchList(2)
MatchList(0) = "Port-A M12 6P Female Orientation"
MatchList(1) = "Port-B M12 6P Female Orientation"
MatchList(2) = "M12 6P Female Orientation"
Case Else
End Select
Case "M12 6P Female"
Select Case f_iMateName
Case "M12 6P Insert"
ReDim MatchList(2)
MatchList(0) = "Port-A M12 6P Male Insert"
MatchList(1) = "Port-B M12 6P Male Insert"
MatchList(2) = "M12 6P Male Insert"
Case "M12 6P Orientation"
ReDim MatchList(2)
MatchList(0) = "Port-A M12 6P Male Orientation"
MatchList(1) = "Port-B M12 6P Male Orientation"
MatchList(2) = "M12 6P Male Orientation"
Case Else
End Select
Case Else
End Select
Case "M12 5Pin Conn"
Select Case f_CiMateName
Case "M12 5P Male"
Select Case f_iMateName
Case "M12 4P/5P Insert"
ReDim MatchList(8)
MatchList(0) = "Port-0 M12 5P Female Insert"
MatchList(1) = "Port-1 M12 5P Female Insert"
MatchList(2) = "Port-2 M12 5P Female Insert"
MatchList(3) = "Port-3 M12 5P Female Insert"
MatchList(4) = "Port-4 M12 5P Female Insert"
MatchList(5) = "Port-5 M12 5P Female Insert"
MatchList(6) = "Port-6 M12 5P Female Insert"
MatchList(7) = "Port-7 M12 5P Female Insert"
MatchList(8) = "M12 5P Female Insert"
Case "M12 5P Orientation"
ReDim MatchList(8)
MatchList(0) = "Port-0 M12 5P Female Orientation"
MatchList(1) = "Port-1 M12 5P Female Orientation"
MatchList(2) = "Port-2 M12 5P Female Orientation"
MatchList(3) = "Port-3 M12 5P Female Orientation"
MatchList(4) = "Port-4 M12 5P Female Orientation"
MatchList(5) = "Port-5 M12 5P Female Orientation"
MatchList(6) = "Port-6 M12 5P Female Orientation"
MatchList(7) = "Port-7 M12 5P Female Orientation"
MatchList(8) = "M12 5P Female Orientation"
Case Else
End Select
Case "M12 5P Female"
Select Case f_iMateName
Case "M12 4P/5P Insert"
ReDim MatchList(8)
MatchList(0) = "Port-0 M12 5P Male Insert"
MatchList(1) = "Port-1 M12 5P Male Insert"
MatchList(2) = "Port-2 M12 5P Male Insert"
MatchList(3) = "Port-3 M12 5P Male Insert"
MatchList(4) = "Port-4 M12 5P Male Insert"
MatchList(5) = "Port-5 M12 5P Male Insert"
MatchList(6) = "Port-6 M12 5P Male Insert"
MatchList(7) = "Port-7 M12 5P Male Insert"
MatchList(8) = "M12 5P Male Insert"
Case "M12 5P Orientation"
ReDim MatchList(8)
MatchList(0) = "Port-0 M12 5P Male Orientation"
MatchList(1) = "Port-1 M12 5P Male Orientation"
MatchList(2) = "Port-2 M12 5P Male Orientation"
MatchList(3) = "Port-3 M12 5P Male Orientation"
MatchList(4) = "Port-4 M12 5P Male Orientation"
MatchList(5) = "Port-5 M12 5P Male Orientation"
MatchList(6) = "Port-6 M12 5P Male Orientation"
MatchList(7) = "Port-7 M12 5P Male Orientation"
MatchList(8) = "M12 5P Male Orientation"
Case Else
End Select
Case Else
End Select
Case "M12 4Pin Conn"
Select Case f_CiMateName
Case "M12 4P Male"
Select Case f_iMateName
Case "M12 4P/5P Insert"
ReDim MatchList(9)
MatchList(0) = "Port-0 M12 5P Female Insert"
MatchList(1) = "Port-1 M12 5P Female Insert"
MatchList(2) = "Port-2 M12 5P Female Insert"
MatchList(3) = "Port-3 M12 5P Female Insert"
MatchList(4) = "Port-4 M12 5P Female Insert"
MatchList(5) = "Port-5 M12 5P Female Insert"
MatchList(6) = "Port-6 M12 5P Female Insert"
MatchList(7) = "Port-7 M12 5P Female Insert"
MatchList(8) = "M12 4P Female Insert"
MatchList(9) = "M12 5P Female Insert"
Case "M12 5P Orientation"
ReDim MatchList(9)
MatchList(0) = "Port-0 M12 5P Female Orientation"
MatchList(1) = "Port-1 M12 5P Female Orientation"
MatchList(2) = "Port-2 M12 5P Female Orientation"
MatchList(3) = "Port-3 M12 5P Female Orientation"
MatchList(4) = "Port-4 M12 5P Female Orientation"
MatchList(5) = "Port-5 M12 5P Female Orientation"
MatchList(6) = "Port-6 M12 5P Female Orientation"
MatchList(7) = "Port-7 M12 5P Female Orientation"
MatchList(8) = "M12 4P Female Orientation"
MatchList(9) = "M12 5P Female Orientation"
Case Else
End Select
Case "M12 4P Female"
Select Case f_iMateName
Case "M12 4P/5P Insert"
ReDim MatchList(9)
MatchList(0) = "Port-0 M12 5P Male Insert"
MatchList(1) = "Port-1 M12 5P Male Insert"
MatchList(2) = "Port-2 M12 5P Male Insert"
MatchList(3) = "Port-3 M12 5P Male Insert"
MatchList(4) = "Port-4 M12 5P Male Insert"
MatchList(5) = "Port-5 M12 5P Male Insert"
MatchList(6) = "Port-6 M12 5P Male Insert"
MatchList(7) = "Port-7 M12 5P Male Insert"
MatchList(8) = "M12 4P Male Insert"
MatchList(9) = "M12 5P Male Insert"
Case "M12 5P Orientation"
ReDim MatchList(9)
MatchList(0) = "Port-0 M12 5P Male Orientation"
MatchList(1) = "Port-1 M12 5P Male Orientation"
MatchList(2) = "Port-2 M12 5P Male Orientation"
MatchList(3) = "Port-3 M12 5P Male Orientation"
MatchList(4) = "Port-4 M12 5P Male Orientation"
MatchList(5) = "Port-5 M12 5P Male Orientation"
MatchList(6) = "Port-6 M12 5P Male Orientation"
MatchList(7) = "Port-7 M12 5P Male Orientation"
MatchList(8) = "M12 4P Male Orientation"
MatchList(9) = "M12 5P Male Orientation"
Case Else
End Select
Case Else
End Select
Case Else
End Select
Create_MatchList = MatchList
End Function
's_Direction works only when Insert, Tangent and Angle mates
Function Create_iMate(ByRef s_Doc As Document, ByVal s_ElmtType As String, ByVal s_CiMateName, s_iMateName, s_iMateType, s_Offset As String, ByVal s_Direction As Boolean) As iMateDefinition
Dim oPCompDef As PartComponentDefinition
Dim oACompDef As AssemblyComponentDefinition
Dim sObjData As FBiMCObj_Datatype
Dim No_sObjData As FBiMCObj_Datatype
Dim nBiasPoint As Point
Dim nObject As Object
Dim nface As Face
Dim nAxis As Axis
Dim nEdge As Object
Dim niMateSuccess As Boolean
Dim oselectedobject As New Cls_GetSelObj_FB
Dim oMateiMateDefinition As MateiMateDefinition
Dim oInsertiMateDefinition As InsertiMateDefinition
Dim oFlushiMateDefinition As FlushiMateDefinition
Dim oTangentiMateDefinition As TangentiMateDefinition
Dim oAngleiMateDefinition As AngleiMateDefinition
Dim oiMateMatchList() As String
If FBiMC.Kill Then Exit Function
If s_Doc.DocumentType = kPartDocumentObject Then Set oPCompDef = s_Doc.ComponentDefinition
If s_Doc.DocumentType = kAssemblyDocumentObject Then Set oACompDef = s_Doc.ComponentDefinition
oiMateMatchList = Create_MatchList(s_CiMateName, s_iMateName, s_ElmtType)
Select Case s_iMateType
Case "Mate":
niMateSuccess = False: FBiMC.Esc = False
Do
If FBiMC.Esc Or FBiMC.Kill Then Exit Do
On Error Resume Next
sObjData = oselectedobject.Get_SObject(s_Doc, s_CiMateName & ">" & s_iMateName & ": Select Planar Face or Press 'Q' for options,'Esc' to Abort", s_iMateType, FBiMC.ElmtType)
Set nObject = sObjData.IMObject
Set nBiasPoint = sObjData.IMBiasPoint
' Select Case nObject.Type
' Case kEdgeProxyObject, kEdgeObject
' Case Else
' Dim dCurrent(2) As Double
' Dim adEye(2) As Double
' adEye(0) = 0
' adEye(1) = 0
' adEye(2) = 0
' Dim adGuessparams() As Double
' Dim adMaxDeviations() As Double
' Dim adParams(1) As Double
' Dim aenSolTypes() As SolutionNatureEnum
' Call nObject.Evaluator.GetParamAtPoint(adEye, adGuessparams, adMaxDeviations, adParams, aenSolTypes)
' If err Then MsgBox err.Description
' MsgBox adParams(0) & "," & adParams(1) & "-" & aenSolTypes(0)
' Call nObject.Evaluator.GetPointAtParam(adParams, dCurrent)
' MsgBox nBiasPoint.X & "," & nBiasPoint.Y & "," & nBiasPoint.Z & vbCrLf & dCurrent(0) & "," & dCurrent(1) & "," & dCurrent(2)
' nBiasPoint.X = nBiasPoint.X - dCurrent(0)
' nBiasPoint.Y = nBiasPoint.Y - dCurrent(1)
' nBiasPoint.Z = nBiasPoint.Z - dCurrent(2)
' End Select
If Err Then MsgBox Err.Description & ":Probably Object or Bias Point not selected", vbCritical, Err.Number & ":" & s_iMateName: Exit Function
On Error GoTo 0
'Set nface = ThisApplication.CommandManager.Pick(kPartFacePlanarFilter, s_iMateName & ":Select a Planar Face.")
If Not nObject Is Nothing Then
Select Case nObject.Type
Case kFaceProxyObject, kFaceObject, kWorkPlaneProxyObject, kWorkPlaneObject
Select Case s_Doc.DocumentType
Case kPartDocumentObject:
If IsArrayInitialized(oiMateMatchList) Then
Set oMateiMateDefinition = oPCompDef.iMateDefinitions.AddMateiMateDefinition(nObject, s_Offset, , nBiasPoint, s_iMateName, oiMateMatchList)
Else
Set oMateiMateDefinition = oPCompDef.iMateDefinitions.AddMateiMateDefinition(nObject, s_Offset, , nBiasPoint, s_iMateName)
End If
Case kAssemblyDocumentObject:
If IsArrayInitialized(oiMateMatchList) Then
Set oMateiMateDefinition = oACompDef.iMateDefinitions.AddMateiMateDefinition(nObject, s_Offset, , , s_iMateName, oiMateMatchList)
Else
Set oMateiMateDefinition = oACompDef.iMateDefinitions.AddMateiMateDefinition(nObject, s_Offset, , , s_iMateName)
End If
End Select
niMateSuccess = True
Case Else: MsgBox " Selected Feature failed for selected imate", vbCritical, s_iMateName
End Select
End If
Loop While niMateSuccess = False
sObjData = No_sObjData
Set Create_iMate = oMateiMateDefinition
Case "Axis":
niMateSuccess = False: FBiMC.Esc = False
Do
If FBiMC.Esc Or FBiMC.Kill Then Exit Do
On Error Resume Next
sObjData = oselectedobject.Get_SObject(s_Doc, s_CiMateName & ">" & s_iMateName & ": Select Cylindrical Face or Press 'Q' for options,'Esc' to Abort", s_iMateType, FBiMC.ElmtType)
Set nObject = sObjData.IMObject
Set nBiasPoint = sObjData.IMBiasPoint
If Err Then MsgBox Err.Description & ":Probably Object or Bias Point not selected", vbCritical, Err.Number & ":" & s_iMateName: Exit Function
On Error GoTo 0
If Not nObject Is Nothing Then
Select Case nObject.Type
Case kFaceProxyObject, kFaceObject
If nObject.SurfaceType = kCylinderSurface Or nObject.SurfaceType = kConeSurface Then
Select Case s_Doc.DocumentType
Case kPartDocumentObject:
If IsArrayInitialized(oiMateMatchList) Then
Set oMateiMateDefinition = oPCompDef.iMateDefinitions.AddMateiMateDefinition(nObject, s_Offset, kInferredLine, , s_iMateName, oiMateMatchList)
Else
Set oMateiMateDefinition = oPCompDef.iMateDefinitions.AddMateiMateDefinition(nObject, s_Offset, kInferredLine, , s_iMateName)
End If
Case kAssemblyDocumentObject:
If IsArrayInitialized(oiMateMatchList) Then
Set oMateiMateDefinition = oACompDef.iMateDefinitions.AddMateiMateDefinition(nObject, s_Offset, kInferredLine, , s_iMateName, oiMateMatchList)
Else
Set oMateiMateDefinition = oACompDef.iMateDefinitions.AddMateiMateDefinition(nObject, s_Offset, kInferredLine, , s_iMateName)
End If
End Select
niMateSuccess = True
Else: MsgBox "Selected Feature not a cylinderical face", vbCritical, s_iMateName
End If
Case Else: MsgBox " Selected Feature failed for selected imate", vbCritical, s_iMateName
End Select
End If
Loop While niMateSuccess = False
sObjData = No_sObjData
Set Create_iMate = oMateiMateDefinition
Case "Flush"
niMateSuccess = False: FBiMC.Esc = False
Do
If FBiMC.Esc Or FBiMC.Kill Then Exit Do
On Error Resume Next
sObjData = oselectedobject.Get_SObject(s_Doc, s_CiMateName & ">" & s_iMateName & ": Select Planar Face or Press 'Q' for options,'Esc' to Abort", s_iMateType, FBiMC.ElmtType)
Set nObject = sObjData.IMObject
Set nBiasPoint = sObjData.IMBiasPoint
If Err Then MsgBox Err.Description & ":Probably Object or Bias Point not selected", vbCritical, Err.Number & ":" & s_iMateName: Exit Function
On Error GoTo 0
If Not nObject Is Nothing Then
Select Case nObject.Type
Case kFaceProxyObject, kFaceObject, kWorkPlaneProxyObject, kWorkPlaneObject
Select Case s_Doc.DocumentType
Case kPartDocumentObject:
If IsArrayInitialized(oiMateMatchList) Then
Set oFlushiMateDefinition = oPCompDef.iMateDefinitions.AddFlushiMateDefinition(nObject, s_Offset, , s_iMateName, oiMateMatchList)
Else
Set oFlushiMateDefinition = oPCompDef.iMateDefinitions.AddFlushiMateDefinition(nObject, s_Offset, , s_iMateName)
End If
Case kAssemblyDocumentObject:
If IsArrayInitialized(oiMateMatchList) Then
Set oFlushiMateDefinition = oACompDef.iMateDefinitions.AddFlushiMateDefinition(nObject, s_Offset, , s_iMateName, oiMateMatchList)
Else
Set oFlushiMateDefinition = oACompDef.iMateDefinitions.AddFlushiMateDefinition(nObject, s_Offset, , s_iMateName)
End If
End Select
niMateSuccess = True
Case Else: MsgBox " Selected Feature failed for selected imate", vbCritical, s_iMateName
End Select
End If
Loop While niMateSuccess = False
sObjData = No_sObjData
Set Create_iMate = oFlushiMateDefinition
Case "Insert":
niMateSuccess = False: FBiMC.Esc = False
Do
If FBiMC.Esc Or FBiMC.Kill Then Exit Do
On Error Resume Next
sObjData = oselectedobject.Get_SObject(s_Doc, s_CiMateName & ">" & s_iMateName & ": Select Circular Edge or Press 'Q' for options,'Esc' to Abort", s_iMateType, FBiMC.ElmtType)
Set nObject = sObjData.IMObject
Set nBiasPoint = sObjData.IMBiasPoint
If Err Then MsgBox Err.Description & ":Probably Object or Bias Point not selected", vbCritical, Err.Number & ":" & s_iMateName: Exit Function
On Error GoTo 0
If Not nObject Is Nothing Then
Select Case nObject.Type
Case kEdgeProxyObject, kEdgeObject
Select Case nObject.GeometryType
Case kCircleCurve, kCircularArcCurve
Select Case s_Doc.DocumentType
Case kPartDocumentObject:
If IsArrayInitialized(oiMateMatchList) Then
Set oInsertiMateDefinition = oPCompDef.iMateDefinitions.AddInsertiMateDefinition(nObject, s_Direction, s_Offset, , s_iMateName, oiMateMatchList)
Else
Set oInsertiMateDefinition = oPCompDef.iMateDefinitions.AddInsertiMateDefinition(nObject, s_Direction, s_Offset, , s_iMateName)
End If
Case kAssemblyDocumentObject:
If IsArrayInitialized(oiMateMatchList) Then
Set oInsertiMateDefinition = oACompDef.iMateDefinitions.AddInsertiMateDefinition(nObject, s_Direction, s_Offset, , s_iMateName, oiMateMatchList)
Else
Set oInsertiMateDefinition = oACompDef.iMateDefinitions.AddInsertiMateDefinition(nObject, s_Direction, s_Offset, , s_iMateName)
End If
End Select
niMateSuccess = True
Case Else: MsgBox " Selected Feature not a Circular edge", vbCritical, s_iMateName
End Select
Case Else: MsgBox " Selected Feature not an edge", vbCritical, s_iMateName
End Select
End If
Loop While niMateSuccess = False
sObjData = No_sObjData
Set Create_iMate = oInsertiMateDefinition
Case "Tangent":
niMateSuccess = False: FBiMC.Esc = False
Do
If FBiMC.Esc Or FBiMC.Kill Then Exit Do
On Error Resume Next
If FBiMC.ElmtType <> Fitting Then
sObjData = oselectedobject.Get_SObject(s_Doc, s_CiMateName & ">" & s_iMateName & ": Select Cylindrical Face or Press 'Q' for options,'Esc' to Abort", s_iMateType, FBiMC.ElmtType)
Else
sObjData = oselectedobject.Get_SObject(s_Doc, s_CiMateName & ">" & s_iMateName & ": Select a Face or Press 'Q' for options,'Esc' to Abort", s_iMateType, FBiMC.ElmtType)
End If
Set nObject = sObjData.IMObject
Set nBiasPoint = sObjData.IMBiasPoint
If Err Then MsgBox Err.Description & ":Probably Object or Bias Point not selected", vbCritical, Err.Number & ":" & s_iMateName: Exit Function
On Error GoTo 0
If Not nObject Is Nothing Then
Select Case nObject.Type
Case kFaceProxyObject, kFaceObject
If FBiMC.ElmtType <> "Fitting" Then
If nObject.SurfaceType = kCylinderSurface Then
If Not IsCylindricalFaceInterior(nObject) Then
Select Case s_Doc.DocumentType
Case kPartDocumentObject:
If IsArrayInitialized(oiMateMatchList) Then
Set oTangentiMateDefinition = oPCompDef.iMateDefinitions.AddTangentiMateDefinition(nObject, s_Direction, s_Offset, , s_iMateName, oiMateMatchList)
Else
Set oTangentiMateDefinition = oPCompDef.iMateDefinitions.AddTangentiMateDefinition(nObject, s_Direction, s_Offset, , s_iMateName)
End If
Case kAssemblyDocumentObject:
If IsArrayInitialized(oiMateMatchList) Then
Set oTangentiMateDefinition = oACompDef.iMateDefinitions.AddTangentiMateDefinition(nObject, s_Direction, s_Offset, , s_iMateName, oiMateMatchList)
Else
Set oTangentiMateDefinition = oACompDef.iMateDefinitions.AddTangentiMateDefinition(nObject, s_Direction, s_Offset, , s_iMateName)
End If
End Select
niMateSuccess = True
Else: MsgBox "Selected Feature not an External cylinderical face", vbCritical
End If
Else: MsgBox "Selected Feature not a cylinderical face", vbCritical, s_iMateName
End If
Else
Select Case s_Doc.DocumentType
Case kPartDocumentObject:
If IsArrayInitialized(oiMateMatchList) Then
Set oTangentiMateDefinition = oPCompDef.iMateDefinitions.AddTangentiMateDefinition(nObject, s_Direction, s_Offset, , s_iMateName, oiMateMatchList)
Else
Set oTangentiMateDefinition = oPCompDef.iMateDefinitions.AddTangentiMateDefinition(nObject, s_Direction, s_Offset, , s_iMateName)
End If
Case kAssemblyDocumentObject:
If IsArrayInitialized(oiMateMatchList) Then
Set oTangentiMateDefinition = oACompDef.iMateDefinitions.AddTangentiMateDefinition(nObject, s_Direction, s_Offset, , s_iMateName, oiMateMatchList)
Else
Set oTangentiMateDefinition = oACompDef.iMateDefinitions.AddTangentiMateDefinition(nObject, s_Direction, s_Offset, , s_iMateName)
End If
End Select
niMateSuccess = True
End If
Case Else: MsgBox " Selected Feature is not a face", vbCritical, s_iMateName
End Select
End If
Loop While niMateSuccess = False
sObjData = No_sObjData
Set Create_iMate = oTangentiMateDefinition
Case "Angle"
niMateSuccess = False: FBiMC.Esc = False
Do
If FBiMC.Esc Or FBiMC.Kill Then Exit Do
On Error Resume Next
sObjData = oselectedobject.Get_SObject(s_Doc, s_CiMateName & ">" & s_iMateName & ": Select Planar Face or Press 'Q' for options,'Esc' to Abort", s_iMateType, FBiMC.ElmtType)
Set nObject = sObjData.IMObject
Set nBiasPoint = sObjData.IMBiasPoint
If Err Then MsgBox Err.Description & ":Probably Object or Bias Point not selected", vbCritical, Err.Number & ":" & s_iMateName: Exit Function
On Error GoTo 0
If Not nObject Is Nothing Then
Select Case nObject.Type
Case kFaceProxyObject, kFaceObject, kWorkPlaneProxyObject, kWorkPlaneObject ' needs to be tested thoroughly
Select Case s_Doc.DocumentType
Case kPartDocumentObject:
If IsArrayInitialized(oiMateMatchList) Then
Set oAngleiMateDefinition = oPCompDef.iMateDefinitions.AddAngleiMateDefinition(nObject, s_Direction, s_Offset, , s_iMateName, oiMateMatchList)
Else
Set oAngleiMateDefinition = oPCompDef.iMateDefinitions.AddAngleiMateDefinition(nObject, s_Direction, s_Offset, , s_iMateName)
End If
Case kAssemblyDocumentObject:
If IsArrayInitialized(oiMateMatchList) Then
Set oAngleiMateDefinition = oACompDef.iMateDefinitions.AddAngleiMateDefinition(nObject, s_Direction, s_Offset, , s_iMateName, oiMateMatchList)
Else
Set oAngleiMateDefinition = oACompDef.iMateDefinitions.AddAngleiMateDefinition(nObject, s_Direction, s_Offset, , s_iMateName)
End If
End Select
niMateSuccess = True
Case Else: MsgBox " Selected Feature failed for selected imate", vbCritical, s_iMateName
End Select
End If
Loop While niMateSuccess = False
sObjData = No_sObjData
Set Create_iMate = oAngleiMateDefinition
End Select
End Function
Function IsArrayInitialized(a) As Boolean
Dim i As Integer
Err.Clear
On Error Resume Next
i = UBound(a)
If (Err.Number = 0) Then
IsArrayInitialized = True
Else
IsArrayInitialized = False
End If
On Error GoTo 0
End Function
Function IsCylindricalFaceInterior(ByVal oFace As Face) As Boolean
If Not oFace.SurfaceType = kCylinderSurface Then
MsgBox "A cylindrical face must be selected."
Exit Function
End If
Dim oCylinder As Cylinder
Set oCylinder = oFace.Geometry
Dim params(1) As Double
params(0) = 0.5
params(1) = 0.5
' Get point on surface at param .5,.5
Dim points(2) As Double
Call oFace.Evaluator.GetPointAtParam(params, points)
' Create point object
Dim oPoint As Point
Set oPoint = ThisApplication.TransientGeometry.CreatePoint(points(0), points(1), points(2))
' Get normal at this point
Dim normals(2) As Double
Call oFace.Evaluator.GetNormal(params, normals)
' Create normal vector object
Dim oNormal As Vector
Set oNormal = ThisApplication.TransientGeometry.CreateVector(normals(0), normals(1), normals(2))
' Scale vector by radius of the cylinder
oNormal.ScaleBy oCylinder.Radius
' Find the sampler point on the normal by adding the
' scaled normal vector to the point at .5,.5 param.
Dim oSamplePoint As Point
Set oSamplePoint = oPoint
oSamplePoint.TranslateBy oNormal
' Check if the sample point lies on the cylinder axis.
' If it does, we have a hollow face.
' Create a line describing the cylinder axis
Dim oAxisLine As Line
Set oAxisLine = ThisApplication.TransientGeometry.CreateLine(oCylinder.BasePoint, oCylinder.AxisVector.AsVector)
'Create a line parallel to the axis passing thru the sample point.
Dim oSampleLine As Line
Set oSampleLine = ThisApplication.TransientGeometry.CreateLine(oSamplePoint, oCylinder.AxisVector.AsVector)
If oSampleLine.IsColinearTo(oAxisLine) Then
'MsgBox "Interior face."
IsCylindricalFaceInterior = True
Else
'MsgBox "Exterior face."
IsCylindricalFaceInterior = False
End If
End FunctionClass Module - Cls_GetSelObj_FB
'Public Variables used -
'Imate_Creator_Pn :- FBiMC.Kill,FBiMC.Esc
'-----------------------XXXXXXXX-----------------
'References Used -
'Imate_Creator_Pn :- FBiMCObj_Datatype
'-----------------------XXXXXXXX-----------------
'Referenced by -
'Imate_Creator_Pn
'Form_Imate_Creator_Pn
'-----------------------XXXXXXXX-----------------
Private WithEvents oInteractionEvents As InteractionEvents
Private WithEvents i_MouseEvents As MouseEvents
Private WithEvents i_SelectEvents As SelectEvents
Private WithEvents i_KeyboardEvents As KeyboardEvents
Private WithEvents uiEvents As UserInputEvents
Private bStillSelecting As Boolean
Private iObject As Object
Private iPoint As Point
Private iFace, iOFace As Face
Private iAxis As Axis
Private iEdge, iOEdge As Edge
Public Function GetFace(ByVal f_Doc As Document, f_Status As String) As Face
f_Doc.SelectSet.Clear
' Create interaction events
Set oInteractionEvents = ThisApplication.CommandManager.CreateInteractionEvents
oInteractionEvents.StatusBarText = f_Status
Set i_KeyboardEvents = oInteractionEvents.KeyboardEvents
Set i_MouseEvents = oInteractionEvents.MouseEvents
Set i_SelectEvents = oInteractionEvents.SelectEvents
i_SelectEvents.ResetSelections
i_SelectEvents.ClearSelectionFilter
i_SelectEvents.SingleSelectEnabled = True
i_SelectEvents.Enabled = True
i_SelectEvents.AddSelectionFilter kPartFacePlanarFilter
i_SelectEvents.AddSelectionFilter kWorkPlaneFilter
bStillSelecting = True
oInteractionEvents.Start
Do While bStillSelecting
DoEvents
Loop
Set GetFace = iFace
End Function
Public Function GetOFace(ByVal f_Doc As Document, f_Status As String) As Face
f_Doc.SelectSet.Clear
' Create interaction events
Set oInteractionEvents = ThisApplication.CommandManager.CreateInteractionEvents
oInteractionEvents.StatusBarText = f_Status
Set i_KeyboardEvents = oInteractionEvents.KeyboardEvents
Set i_SelectEvents = oInteractionEvents.SelectEvents
i_SelectEvents.ResetSelections
i_SelectEvents.SingleSelectEnabled = True
i_SelectEvents.Enabled = True
i_SelectEvents.ClearSelectionFilter
i_SelectEvents.AddSelectionFilter kPartFaceCylindricalFilter
i_SelectEvents.AddSelectionFilter kPartFaceConicalFilter
bStillSelecting = True
oInteractionEvents.Start
Do While bStillSelecting
DoEvents
Loop
Set GetOFace = iOFace
End Function
Public Function GetOEdge(ByVal f_Doc As Document, f_Status As String) As Edge
f_Doc.SelectSet.Clear
' Create interaction events
Set oInteractionEvents = ThisApplication.CommandManager.CreateInteractionEvents
oInteractionEvents.StatusBarText = f_Status
Set i_KeyboardEvents = oInteractionEvents.KeyboardEvents
Set i_SelectEvents = oInteractionEvents.SelectEvents
i_SelectEvents.ResetSelections
i_SelectEvents.ClearSelectionFilter
i_SelectEvents.SingleSelectEnabled = True
i_SelectEvents.Enabled = True
i_SelectEvents.AddSelectionFilter kPartEdgeCircularFilter
bStillSelecting = True
oInteractionEvents.Start
Do While bStillSelecting
DoEvents
Loop
Set GetOEdge = iOEdge
End Function
'Public Function Get_Object(ByVal f_Doc As Document, ByVal f_Status, i_iMatetype As String) As Object ' WIP
Public Function Get_SObject(ByVal f_Doc As Document, ByVal f_Status, i_iMatetype, f_ElementType As String) As FBiMCObj_Datatype ' WIP
FBiMC.Esc = False
f_Doc.SelectSet.Clear
' Create interaction events
Set oInteractionEvents = ThisApplication.CommandManager.CreateInteractionEvents
oInteractionEvents.StatusBarText = f_Status
'oInteractionEvents.InteractionDisabled = False
Set i_KeyboardEvents = oInteractionEvents.KeyboardEvents
Set i_SelectEvents = oInteractionEvents.SelectEvents
i_SelectEvents.ResetSelections
i_SelectEvents.ClearSelectionFilter
i_SelectEvents.SingleSelectEnabled = True
i_SelectEvents.Enabled = True
Select Case i_iMatetype
Case "Mate", "Flush":
i_SelectEvents.AddSelectionFilter kPartFacePlanarFilter
Case "Angle":
i_SelectEvents.AddSelectionFilter kPartFacePlanarFilter
i_SelectEvents.AddSelectionFilter kWorkPlaneFilter
Case "Axis":
i_SelectEvents.AddSelectionFilter kPartFaceCylindricalFilter ' To be changed here to Axis Selection Filter right now workaround is by selecting face
i_SelectEvents.AddSelectionFilter kPartFaceConicalFilter
Case "Tangent":
If f_ElementType <> "Fitting" Then
i_SelectEvents.AddSelectionFilter kPartFaceCylindricalFilter
'i_SelectEvents.AddSelectionFilter kPartFaceConicalFilter
Else
i_SelectEvents.AddSelectionFilter kPartFacePlanarFilter
End If
Case "Insert": i_SelectEvents.AddSelectionFilter kPartEdgeCircularFilter
End Select
bStillSelecting = True
oInteractionEvents.Start
Do While bStillSelecting
DoEvents
Loop
Set Get_SObject.IMObject = iObject
Set Get_SObject.IMBiasPoint = iPoint 'Suppress in case function returns Object instead of FBiMCObj_Datatype
'MsgBox Get_SObject.IMBiasPoint.X & "," & Get_SObject.IMBiasPoint.Y & "," & Get_SObject.IMBiasPoint.Z
End Function
Private Sub i_SelectEvents_OnSelect(ByVal JustSelectedEntities As ObjectsEnumerator, ByVal SelectionDevice As SelectionDeviceEnum, ByVal ModelPosition As Point, ByVal ViewPosition As Point2d, ByVal View As View)
Set iPoint = ModelPosition
On Error Resume Next
Set iObject = i_SelectEvents.SelectedEntities(1)
Set iFace = i_SelectEvents.SelectedEntities(1)
Set iOFace = i_SelectEvents.SelectedEntities(1)
Set iAxis = i_SelectEvents.SelectedEntities(1)
'Set iEdge = i_Selectevents.SelectedEntities(1)
Set iOEdge = i_SelectEvents.SelectedEntities(1)
On Error GoTo 0
bStillSelecting = False
End Sub
Private Sub i_MouseEvents_OnMouseClick(ByVal Button As MouseButtonEnum, ByVal ShiftKeys As ShiftStateEnum, ByVal ModelPosition As Inventor.Point, ByVal ViewPosition As Point2d, ByVal View As Inventor.View)
Set iPoint = ModelPosition
bStillSelecting = False
End Sub
Private Sub i_KeyboardEvents_OnKeyPress(ByVal KeyAscii As Long)
Dim i As Integer
If KeyAscii = 113 Or KeyAscii = 81 Then ' Ascii Code for "q" and "Q"
i = MsgBox("Do you want to escape creating this iMate", vbQuestion + vbDefaultButton2 + vbAbortRetryIgnore) 'Selecting no here does go back to control. needs to be sorted out.
Select Case i
Case 5: bStillSelecting = False: FBiMC.Esc = True
Case 4: bStillSelecting = True
Case 3: FBiMC.Kill = True: bStillSelecting = False
End Select
End If
End Sub
Private Sub oInteractionEvents_OnTerminate() ' on Keypress esc
Dim i As Integer
i = MsgBox("Terminating the Interaction Process", vbCritical + vbOKOnly) 'Option to return not working as selection filter fails here perhaps interaction event dies here
Select Case i
Case 5: bStillSelecting = False
Case 4: bStillSelecting = True
Case 1: FBiMC.Kill = True: bStillSelecting = False
End Select
End Sub
Private Sub uiEvents_OnTerminateCommand(ByVal CommandName As String, ByVal Context As NameValueMap)
Set uiEvents = Nothing
Dim i As Integer
i = MsgBox("Do you want to escape creating this iMate", vbQuestion + vbDefaultButton2 + vbAbortRetryIgnore, CommandName)
Select Case i
Case 5: bStillSelecting = False: FBiMC.Esc = True
Case 4: bStillSelecting = True
Case 3: FBiMC.Kill = True: bStillSelecting = False
End Select
End Sub