HI everyone!
Hi have a assembly with several sub-assemblys , the sub-assemblys contain a assembly called a "Suporte rolos sup".
for example:
subassembly 1
- subassembly 1
- Suporte rolos sup
subassembly 2
- Suporte rolos sup
- subassembly 2
the assembly "Suporte rolos sup", has a attribute in a face.
so for every assembly "Suporte rolos sup" in the main assembly , i want to measure the distance between the face that has that attribute.
I'm trying to do that with the code bellow but the following error:
-run time error '5'
-invalide procedure,call or argument
is displayed in the line" Distance = ThisApplication.MeasureTools.GetMinimumDistance(oface1, oface2)"
Option explicit
Dim oface1 As Face
Dim oface2 As Face
Private Sub calc_esp_entre_estacoes()
Dim odoc As Inventor.Document
Set odoc = ThisApplication.ActiveDocument
Dim odoc_ass As Inventor.AssemblyDocument
If odoc.DocumentType = kAssemblyDocumentObject Then
Set odoc_ass = odoc
Else
MsgBox "O documento is not a assembly"
Exit Sub
End If
For i = 1 To odoc_ass.ComponentDefinition.Occurrences.Count
Dim Pos
Pos = InStr(odoc_ass.ComponentDefinition.Occurrences(i).Name, "Suporte rolos sup")
If Pos <> 0 Then
Dim odoc_atrib As Inventor.Document
Set odoc_atrib = odoc_ass.ComponentDefinition.Occurrences(i).Definition.Document
Call GetAttributeUsingManager(odoc_atrib)
End If
If odoc_ass.ComponentDefinition.Occurrences(i).DefinitionDocumentType = kAssemblyDocumentObject Then
Call subocc(odoc_ass.ComponentDefinition.Occurrences(i).Definition.Document)
End If
Next i
End Sub
Public Sub subocc(odoc As Inventor.AssemblyDocument)
Dim i As Integer
Dim Pos
Dim subdoc As Inventor.AssemblyDocument
For i = 1 To odoc.ComponentDefinition.Occurrences.Count
Pos = InStr(odoc.ComponentDefinition.Occurrences(i).Name, "Suporte rolos sup")
If Pos <> 0 Then
Dim odoc_atrib As Inventor.Document
Set odoc_atrib = odoc.ComponentDefinition.Occurrences(i).Definition.Document
Call GetAttributeUsingManager(odoc_atrib)
End If
If odoc.ComponentDefinition.Occurrences(i).DefinitionDocumentType = kAssemblyDocumentObject Then
Set subdoc = odoc.ComponentDefinition.Occurrences(i).Definition.Document
Call subocc(subdoc)
End If
Next i
End Sub
Public Sub GetAttributeUsingManager(doc As Inventor.Document)
' Get the active document. It can be any type of document.
'Dim doc As Document
'Set doc = ThisApplication.ActiveDocument
' Get the attribute manager.
Dim attribMgr As AttributeManager
Set attribMgr = doc.AttributeManager
' Find all attribute sets named "SampleSet".
Dim foundEntities As ObjectCollection
Set foundEntities = attribMgr.FindObjects("SampleSet")
If foundEntities.Count <> 0 Then
Dim foundEntity As Object
For Each foundEntity In foundEntities
If TypeOf foundEntity Is Face Then
If oface1 Is Nothing Then
Set oface1 = foundEntity
Exit For
End If
If Not (oface1 Is Nothing) Then Set oface2 = foundEntity
ElseIf TypeOf foundEntity Is Edge Then
End If
Next
End If
If (Not (oface1 Is Nothing)) And (Not (oface2 Is Nothing)) Then
Dim Distance As Double
Distance = ThisApplication.MeasureTools.GetMinimumDistance(oface1, oface2)
Distance = doc.UnitsOfMeasure.ConvertUnits(Distance, "cm", "mm")
ListBox3.AddItem (Distance)
Set oface1 = Nothing
Set oface2 = Nothing
End If
End Sub
Since you are doing this in the context of an assembly, the inputs to the GetMinimumDistance need to be FaceProxy objects instead of Face objects. Look into programming help overview that discuss the concept of proxies.
Hi Sanjay!
and thanks for your answer and time , but i'm a little bit confused with this proxyies, after reading the little help overview article , i dont know in what way do i have to change my code to get the desired results, what do i have to change??, do i will have to use component definiton and component occurrence? if yes i will have to use component defintion and ocurrences, how can i get wich occurence has the selected attribute?
can i get a reference to the subassembly face that has the attributes?
I would like to have more information about this proxyies , because i'm new to this.
Thanks a lot for your help
My mistake. I looked at your code again and it looks like you intend to measure the distance between faces on the same part. In which case, you don't need to worry about proxies. However, it seems like the logic in the following piece of your code is not quite right. When I removed the 'Exit For' statement, I was able to get it to work. You may want to re-check the logic.
For Each foundEntity In foundEntities If TypeOf foundEntity Is Face Then If oface1 Is Nothing Then Set oface1 = foundEntity Exit For End If If Not (oface1 Is Nothing) Then Set oface2 = foundEntity ElseIf TypeOf foundEntity Is Edge Then End If Next
Hi again Sanjay!
hell i have changed the following code, has you said, but i get the same error.
de variable count is a global variable.
Can you be more clear of what is missing here.
thanks a lot for your help.
If foundEntities.Count <> 0 Then
Dim foundEntity As Object
For Each foundEntity In foundEntities
If TypeOf foundEntity Is Face Then
If count = 0 Then
Set oface1 = foundEntity
count = 1
ElseIf count = 1 Then
Set oface2 = foundEntity
count = 2
End If
ElseIf TypeOf foundEntity Is Edge Then
End If
Next
End If
If count = 2 Then
Dim Distance As Double
Distance = ThisApplication.MeasureTools.GetMinimumDistance(oface1, oface2)
Distance = doc.UnitsOfMeasure.ConvertUnits(Distance, "cm", "mm")
ListBox3.AddItem (Distance)
Set oface1 = Nothing
Set oface2 = Nothing
End If
Since count seems to be a global variable, are you making sure to initialize it to 0 before every run? I put that in, and with that change, your new logic seems to work fine for me and correctly returns the distance.
Hi Sanjay!
Again i have changed the code and nothing, i get the same error display, are you sure that you have your code running?
Can you send the code you have ?so i can see what is going wrong here?
Thanks a lot.
If foundEntities.count <> 0 Then
Dim foundEntity As Object
For Each foundEntity In foundEntities
If TypeOf foundEntity Is Face Then
If count = 0 Then
Set oface1 = foundEntity
count = 1
ElseIf count = 1 Then
Set oface2 = foundEntity
count = 2
End If
ElseIf TypeOf foundEntity Is Edge Then
End If
Next
End If
If count = 2 Then
Dim Distance As Double
Distance = ThisApplication.MeasureTools.GetMinimumDistance(oface1, oface2)
Distance = doc.UnitsOfMeasure.ConvertUnits(Distance, "cm", "mm")
ListBox3.AddItem (Distance)
Set oface1 = Nothing
Set oface2 = Nothing
count = 0
End If
Yes, I have the code working in Inventor 2011. I've changed the names of the occurrence and the attribute set to match my dataset - you'll need to change those back. I've highlighted the changes that I made in red.
Option Explicit Dim oface1 As Face Dim oface2 As Face Dim count As Long Private Sub calc_esp_entre_estacoes() count = 0 Dim odoc As Inventor.Document Set odoc = ThisApplication.ActiveDocument Dim odoc_ass As Inventor.AssemblyDocument If odoc.DocumentType = kAssemblyDocumentObject Then Set odoc_ass = odoc Else MsgBox "O documento is not a assembly" Exit Sub End If Dim i As Long For i = 1 To odoc_ass.ComponentDefinition.Occurrences.count Dim Pos Pos = InStr(odoc_ass.ComponentDefinition.Occurrences(i).Name, "block") If Pos <> 0 Then Dim odoc_atrib As Inventor.Document Set odoc_atrib = odoc_ass.ComponentDefinition.Occurrences(i).Definition.Document Call GetAttributeUsingManager(odoc_atrib) End If If odoc_ass.ComponentDefinition.Occurrences(i).DefinitionDocumentType = kAssemblyDocumentObject Then Call subocc(odoc_ass.ComponentDefinition.Occurrences(i).Definition.Document) End If Next i End Sub Public Sub subocc(odoc As Inventor.AssemblyDocument) Dim i As Integer Dim Pos Dim subdoc As Inventor.AssemblyDocument For i = 1 To odoc.ComponentDefinition.Occurrences.count Pos = InStr(odoc.ComponentDefinition.Occurrences(i).Name, "block") If Pos <> 0 Then Dim odoc_atrib As Inventor.Document Set odoc_atrib = odoc.ComponentDefinition.Occurrences(i).Definition.Document Call GetAttributeUsingManager(odoc_atrib) End If If odoc.ComponentDefinition.Occurrences(i).DefinitionDocumentType = kAssemblyDocumentObject Then Set subdoc = odoc.ComponentDefinition.Occurrences(i).Definition.Document Call subocc(subdoc) End If Next i End Sub Public Sub GetAttributeUsingManager(doc As Inventor.Document) ' Get the active document. It can be any type of document. 'Dim doc As Document 'Set doc = ThisApplication.ActiveDocument ' Get the attribute manager. Dim attribMgr As AttributeManager Set attribMgr = doc.AttributeManager ' Find all attribute sets named "SampleSet". Dim foundEntities As ObjectCollection Set foundEntities = attribMgr.FindObjects("AttribTest") If foundEntities.count <> 0 Then Dim foundEntity As Object For Each foundEntity In foundEntities If TypeOf foundEntity Is Face Then If count = 0 Then Set oface1 = foundEntity count = 1 ElseIf count = 1 Then Set oface2 = foundEntity count = 2 End If ElseIf TypeOf foundEntity Is Edge Then End If Next End If If count = 2 Then Dim Distance As Double Distance = ThisApplication.MeasureTools.GetMinimumDistance(oface1, oface2) Distance = doc.UnitsOfMeasure.ConvertUnits(Distance, "cm", "mm") MsgBox "Distance = " & Distance & " mm" 'ListBox3.AddItem (Distance) Set oface1 = Nothing Set oface2 = Nothing End If End Sub
hello sanjay,
how to get minimum distance from a face to point using vba??
if face is oFace and point is pnt???
Dim dD As Double
Dim oFace as Face
Dim pnt as workpoint
dD = ThisApplication.MeasureTools.GetMinimumDistance(oFace(1), pnt.Point)
debug.Print dD
Thanks in advance for you reply.
Amool.
Hi,
From your description it's not obvious what the problem is. There is an issue in your code but I don't know if it's just a typo in the pasted code or that is the actual issue you are experienceing.
If oFace is of type Face, then oFace(1) is an invalid expression since oFace is not an array.