- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hi,
I have an assembly with an attribute as shown
I want to add a balloon (No. 20) on a specific view ( detail E) automatically as shown
I am developing a code in VBA but got stuck when I try to execute the following line
Set oViewCurves = oView.DrawingCurves(oFaceProxy)
the error message that appears says Method 'DrawingCurves' of object "DetailDrawingView" failed
Here is my code to suggest for me an amendment
Thanks
Sub Balloons()
'Reference the file that's open
Dim oDrawDoc As DrawingDocument
Set oDrawDoc = ThisApplication.ActiveDocument
'Reference the active Sheet
Dim oSheet As Sheet
Set oSheet = oDrawDoc.Sheets.Item(1)
'Reference the View we want
For i = 1 To oSheet.DrawingViews.Count
If oSheet.DrawingViews.Item(i).Name = "E" Then
Dim oView As DrawingView
Set oView = oSheet.DrawingViews.Item(i)
End If
Next
'Reference the Asembly Model on that Sheet
Dim oAssemblyDoc As Document
Set oAssemblyDoc = oView.ReferencedDocumentDescriptor.ReferencedDocument
Dim oTG As TransientGeometry
Set oTG = ThisApplication.TransientGeometry
'reference the assigned attribute on the Assembly Model
Dim oMainObjs As ObjectCollection
Set oMainObjs = oAssemblyDoc.AttributeManager.FindObjects("Balloon", "W01_Outer")
'reference to the Occerrence of tha Assembly Model
Dim oOcc As ComponentOccurrence
Set oOcc = oAssemblyDoc.ComponentDefinition.Occurrences.ItemByName(oMainObjs.Item(1).ContainingOccurrence.Name)
'reference to the Wanted Face
Dim oFace As Face
Set oFace = oMainObjs.Item(1)
'Promote to Proxy Face
Dim oFaceProxy As Inventor.FaceProxy
Call oOcc.CreateGeometryProxy(oFace, oFaceProxy)
'Promote to an DrawingCurve on the View
Dim oCurves As DrawingCurve
Set oViewCurves = oView.DrawingCurves(oFaceProxy)
Set oCurves = oViewCurves.Item(1)
End Sub
Solved! Go to Solution.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hi @mostafamahmoudseddek94. Retrieving named geometry to work with in a drawing from a multi-level assembly, can definitely be challenging. Especially when it may be down one or more levels below the top level of the assembly. I added quite a bit of code to your VBA macro to help debug where something might be going wrong. I also added a custom recursive component search function at the end. I don't know if this will fix all your problems or not, but it's probably at least a pretty good start in that direction. You could review this code first, then give it a try if you want.
Sub Balloons()
'Reference the file that's open
Dim oDrawDoc As DrawingDocument
Set oDrawDoc = ThisApplication.ActiveDocument
'Reference the active Sheet
Dim oSheet As Sheet
Set oSheet = oDrawDoc.Sheets.Item(1)
'Reference the View we want
Dim oEView As DrawingView
Dim oView As DrawingView
For Each oView In oSheet.DrawingViews
If oView.Name = "E" Then
Set oEView = oView
End If
Next
If oEView Is Nothing Then
Call MsgBox("View named 'E' not found. Exiting.", vbCritical, "")
Exit Sub
End If
'Reference the Asembly Model on that Sheet
Dim oAssemblyDoc As Document
Set oAssemblyDoc = oView.ReferencedDocumentDescriptor.ReferencedDocument
Dim oTG As TransientGeometry
Set oTG = ThisApplication.TransientGeometry
'reference the assigned attribute on the Assembly Model
Dim oMainObjs As ObjectCollection
Set oMainObjs = oAssemblyDoc.AttributeManager.FindObjects("Balloon", "W01_Outer")
If oMainObjs.Count = 0 Then
Call MsgBox("Named geometry for balloon not found. Exiting.", vbCritical, "")
Exit Sub
End If
'check Type of 1st object (is it Face or FaceProxy)
Dim oObj1 As Object
Set oObj1 = oMainObjs.Item(1)
Dim oTypeName As String
oTypeName = TypeName(oObj1)
Call MsgBox("The TypeName of the first found object = " & oTypeName, vbInformation, "")
Dim oFace As Face
Dim oFaceProxy As FaceProxy
If oTypeName = "Face" Then
Set oFace = oObj1
ElseIf oTypeName = "FaceProxy" Then
Set oFaceProxy = oObj1
Else
Exit Sub
End If
If oFace Is Nothing And oFaceProxy Is Nothing Then Exit Sub
If oFace Is Nothing And oFaceProxy Is Not Nothing Then GoTo GetDCurves
'get ComponentDefinition from oFace
Dim oCD As ComponentDefinition
Set oCD = oFace.SurfaceBody.ComponentDefinition
'find the (or a) component that represents this oCD
Dim oContainingOcc As ComponentOccurrence
Set oContainingOcc = RecusiveComponentSearch(oAssemblyDoc.ComponentDefinition.Occurrences, oCD)
If oContainingOcc Is Nothing Then Exit Sub
Dim oParentOcc As ComponentOccurrence
'this assumes the containing occurrence was on second level
'and assumes this parent occurrence is on the top level
Set oParentOcc = oContainingOcc.ParentOccurrence
'Promote to Proxy Face
Call oParentOcc.CreateGeometryProxy(oFace, oFaceProxy)
GetDCurves:
'Promote to an DrawingCurve on the View
Dim oViewCurves As DrawingCurvesEnumerator
Set oViewCurves = oView.DrawingCurves(oFaceProxy)
If oViewCurves.Count = 0 Then
Call MsgBox("No curves found in view.", vbExclamation, "")
Exit Sub
End If
Dim oDCurve As DrawingCurve
Set oDCurve = oViewCurves.Item(1)
Call MsgBox("Got the drawing curve.", vbInformation, "")
End Sub
Function RecusiveComponentSearch(oComps As ComponentOccurrences, oCompDef As ComponentDefinition) As ComponentOccurrence
Dim oTartetComp As ComponentOccurrence
Dim oComp As ComponentOccurrence
For Each oComp In oComps
If oComp.Definition Is oCompDef Then
RecusiveComponentSearch = oComp
Exit Function
End If
If oComp.DefinitionDocumentType = kAssemblyDocumentObject Then
RecusiveComponentSearch = RecusiveComponentSearch(oComp.Definition.Occurrences, oCompDef)
If Not RecusiveComponentSearch Is Nothing Then
Exit Function
End If
End If
Next
RecusiveComponentSearch = Nothing
End Function
If this solved your problem, or answered your question, please click ACCEPT SOLUTION.
Or, if this helped you, please click (LIKE or KUDOS)
.
If you want and have time, I would appreciate your Vote(s) for My IDEAS :bulb: or you can Explore My CONTRIBUTIONS
Wesley Crihfield
(Not an Autodesk Employee)
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hi, Thanks for your code which inspired me to develop and complete mine. I have a problem getting drawing curves for balloon item number 28 since it is a cylinder oDrawingCurves(oFaceProxy) that has no items.
what is the change should I apply to get a drawing curve regardless of the type of curve itself?
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
I have written some blog post about generating dimensions (using attributes) in assembly drawings. The most important thing is probably getting the intent. I guess that you also need to find an intent to attach the ballons at. You might want to check the post "Add function "GetProxyIntent()" to Ilogic". You also might want to check out the other articles in that serie.
Jelte de Jong
Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
Blog: hjalte.nl - github.com
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hi,
The link is not working. May you provide me with another one?
I do not have an idea to get a drawing edge of a circular (cylindrical object), and I am highly interested to read your articles
Thanks
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hi,
Thanks for providing your code which profoundly inspired me to overcome some obstacles. However, I developed my own code. This is the most sophisticated code I have written
Public GOccName As String
Sub main()
Call AddBalloon("E", "W04_Outer", 2, 2, 0.5)
'Call AddBalloon("E", "BlowPipe_01", -1, -1, 0.5)
' This does not work because it is a pipe projected in the drawing (Balloon 'item No.28) as shown in the figure in the post
End Sub
Sub AddBalloon(viewName As String, AttributeName As String, x As Double, y As Double, intent As Double)
'Reference the drwing file A8-003 that must be open
If ThisApplication.ActiveDocument.DocumentType <> _
DocumentTypeEnum.kDrawingDocumentObject Then
Call MsgBox("The drawing document is Not active." _
& " Please Activate it first", vbOKOnly, "Document Type")
Exit Sub
Else
Dim oDrawDoc As DrawingDocument
Set oDrawDoc = ThisApplication.ActiveDocument
End If
'Reference the active Sheet must be NO.1
If oDrawDoc.DisplayName <> "1Fxxx-A8-0x.dwg" Then
Call MsgBox(" You need to open A8-003 Drawing", vbCritical, "Drawing file")
Else
Dim oSheet As Sheet
Set oSheet = oDrawDoc.Sheets.Item(1)
End If
'Reference the View we want
Dim sViewName As String
sViewName = viewName
For i = 1 To oSheet.DrawingViews.Count
If oSheet.DrawingViews.Item(i).Name = viewName Then
Dim oView As DrawingView
Set oView = oSheet.DrawingViews.Item(i)
End If
Next
If oView Is Nothing Then
Call MsgBox("View named " & sViewName & " was not found. Exiting.", vbCritical, "Drawing View")
Exit Sub
ElseIf oView.Suppressed = True Then
oView.Suppressed = False
Exit Sub
End If
'Reference the Model on that Sheet
Dim oAssemblyDoc As Document
Set oAssemblyDoc = oView.ReferencedDocumentDescriptor.ReferencedDocument
'Find the assigned Attribute on an Object
Dim sAttributeSetName As String
Dim sAttributeName As String
sAttributeSetName = "Balloon"
sAttributeName = AttributeName
Dim oObjs As ObjectCollection
Set oObjs = oAssemblyDoc.AttributeManager _
.FindObjects(sAttributeSetName, sAttributeName)
If oObjs.Count = 0 Then
Call MsgBox("attribute name " & sAttributeName & _
" was not found. Exiting.", vbCritical, "Attribute object")
Exit Sub
End If
' get the face of the object
Dim oTypeName As String
oTypeName = TypeName(oObjs.Item(1))
Dim oFace As Face
Dim oFaceProxy As FaceProxy
Dim oOccName As String
If oTypeName = "Face" Then
Set oFace = oObjs.Item(1)
oOccName = oFace.ContainingOccurrence.Name
ElseIf oTypeName = "FaceProxy" Then
Set oFaceProxy = oObjs.Item(1)
oOccName = oFaceProxy.ContainingOccurrence.Name
Else
Call MsgBox("the assigned object's Face was Not found. Exiting", vbCritical, "Face")
Exit Sub
End If
GOccName = oOccName
' get the occurrence of the detected face
Dim Oocc As ComponentOccurrence
Set Oocc = OccSearch(oAssemblyDoc)
If Oocc Is Nothing Then
Call MsgBox("the Occurrence of the detected object is Not found. Exiting", vbCritical, "Occurrence")
Exit Sub
End If
Dim oParentOcc As ComponentOccurrence
Set oParentOcc = Oocc.ParentOccurrence
If oTypeName = "Face" Then
Call Oocc.CreateGeometryProxy(oFace, oFaceProxy)
If Not oParentOcc Is Nothing Then
Call oParentOcc.CreateGeometryProxy(oFace, oFaceProxy)
End If
End If
'Promote to an DrawingCurve on the View
Dim oViewAllCurves As DrawingCurvesEnumerator
Dim oViewCurves As DrawingCurvesEnumerator
Set oViewAllCurves = oView.DrawingCurves
For i = 1 To oViewAllCurves.Count
If oViewAllCurves.Item(i).StartPoint Is Nothing Or _
oViewAllCurves.Item(i).Evaluator3D Is Nothing Or _
oViewAllCurves.Item(i).ModelGeometry Is Nothing Then
i = i + 1
Else
If oViewAllCurves.Item(i).ModelGeometry.ContainingOccurrence.Name = oOccName Then
Set oViewCurves = oView.DrawingCurves(oFaceProxy)
Exit For
End If
End If
Next
If oViewCurves Is Nothing Then
Call MsgBox("Occurrence does not belong to the view. Exiting", vbExclamation, "View Refrence Documents")
Exit Sub
End If
If oViewCurves.Count = 0 Then
Call MsgBox("No curves found in view. Exiting", vbExclamation, "Drawing Curves")
Exit Sub
End If
Dim ocurve As DrawingCurve
Set ocurve = oViewCurves.Item(1)
' locate a text point for the Balloon relative to the assigned curve
Dim oMidPoint As Point2d
Set oMidPoint = ocurve.MidPoint
Dim oTG As TransientGeometry
Set oTG = ThisApplication.TransientGeometry
Dim Xpos As Double
Dim Ypos As Double
Xpos = oMidPoint.x + x
Ypos = oMidPoint.y + y
Set oPoint = oTG.CreatePoint2d(Xpos, Ypos)
' Attach Balloon to the text point
Dim oLeaderPoint As ObjectCollection
Set oLeaderPoint = ThisApplication.TransientObjects _
.CreateObjectCollection
Call oLeaderPoint.Add(oPoint)
' locate a leader point for the Balloon
Dim GI As GeometryIntent
Set GI = oSheet.CreateGeometryIntent(ocurve, intent)
Call oLeaderPoint.Add(GI)
' Deleting the dublicated Balloon if any
Dim K As Integer
K = oSheet.Balloons.Count ' Number of Balloons
Dim counter As Integer
counter = 0 ' Number of similar balloons
For i = 1 To K
While i < K
If oSheet.Balloons.Item(i).ParentView.Name = sViewName Then
If oSheet.Balloons.Item(i).Position.x = Xpos And _
oSheet.Balloons.Item(i).Position.y = Ypos Then
oSheet.Balloons.Item(i).Delete
K = K - 1
End If
End If
i = i + 1
Wend
Next
' Adding the Balloon
Dim oBalloon As Balloon
Set oBalloon = oSheet.Balloons.Add(oLeaderPoint)
' Deleting previously exsited balloon if any
Dim oBalloonItemNumber As String
oBalloonItemNumber = oBalloon.BalloonValueSets _
.Item(1).ItemNumber
K = oSheet.Balloons.Count ' Updated Number of Balloons
For i = 1 To K
While i < K
If oSheet.Balloons.Item(i).ParentView.Name = sViewName _
And oSheet.Balloons.Item(i).BalloonValueSets _
.Item(1).ItemNumber = oBalloonItemNumber _
And oSheet.Balloons.Item(i).Position.x <> Xpos And _
oSheet.Balloons.Item(i).Position.y <> Ypos Then
counter = counter + 1
If counter >= 1 Then
oSheet.Balloons.Item(i).Delete
K = K - 1
i = i - 1
End If
End If
i = i + 1
Wend
Next
End Sub
Function OccSearch(AssemblyDoc As AssemblyDocument) As ComponentOccurrence
Dim CompName As String
For Each SubCompOcc In AssemblyDoc.ComponentDefinition.Occurrences
CompName = SubCompOcc.Name
If CompName = GOccName Then
Set OccSearch = SubCompOcc
Exit Function
End If
If SubCompOcc.Visible = True And _
SubCompOcc.Suppressed = False And _
SubCompOcc.BOMStructure = kNormalBOMStructure And _
SubCompOcc.DefinitionDocumentType = kAssemblyDocumentObject Then
'MsgBox "ATTWNTION"
Set OccSearch = OccSearch(SubCompOcc.Definition.Document)
If Not OccSearch Is Nothing Then
Exit Function
End If
End If
Next
Set OccSearch = Nothing
End Functionso far that I wanted to share with you to even develop it further. Thanks to @WCrihfield
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hi @mostafamahmoudseddek94. I don't know if the code in your last post is working for you yet, but I'm betting not. When quickly looking it over this morning I saw something that is most likely a problem/mistake. Within your 'AddBalloon' sub routine, at the point you are attempting to get the DrawingView object, you are declaring your oView variable, and setting its value, all within both a For...Next block, and within a If...Then block. In order to retain that variable and its value, you must at least declare the variable before, and outside of those two blocks of code. It's OK to set its value within those blocks though. When you declare a variable within a lower level block of code, it only exists within that lower level block of code, and does not exist at the higher level block of code. So, the following block of code that is checking 'If oView is Nothing' will likely always be True, until you fix that. Also, I noticed that you created a new variable called 'sViewName' just before this point. That is totally unnecessary. You could just delete that, then in the message following the 'oView Is Nothing' check, replace 'sViewName' variable with the original 'viewName' variable. Just a couple quick thoughts.
Wesley Crihfield
(Not an Autodesk Employee)
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
This is the Code to add a balloon using VBA with the Attribute helper.
Sub AddBalloon(SheetNo As Double, viewName As String, AttributeName As String _
, xPosition As Double, yPosition As Double, intent As Double)
' 1- Reference the drwing file A8-003 that must be open specifically
If ThisApplication.ActiveDocument.DocumentType <> _
DocumentTypeEnum.kDrawingDocumentObject Then
Call MsgBox("The drawing document is Not active." _
& " Please Activate it first", vbOKOnly, "Document Type")
BCheck = False
Exit Sub
Else
Dim oDrawDoc As DrawingDocument
Set oDrawDoc = ThisApplication.ActiveDocument
End If
' 2- Reference the active Sheet
If oDrawDoc.DisplayName <> "1Fxxx-A8-0x.dwg" Then
Call MsgBox(" You need to open A8-003 Drawing", vbCritical, "Drawing file")
BCheck = False
Exit Sub
Else
Dim oSheet As Sheet
Set oSheet = oDrawDoc.Sheets.Item(SheetNo)
End If
' 3- Reference the needed drwing View
Dim oView As DrawingView
For i = 1 To oSheet.DrawingViews.Count
If oSheet.DrawingViews.Item(i).Name = viewName Then
Set oView = oSheet.DrawingViews.Item(i)
End If
Next
'Verify that the selected drawing view exist, and not suppressed.
If oView Is Nothing Then
Call MsgBox("View named (" & viewName & ") was not found. Exiting.", vbCritical, "Drawing View")
BCheck = False
Exit Sub
ElseIf oView.Suppressed = True Then
oView.Suppressed = False
BCheck = False
Exit Sub
End If
' 4- Reference the Model on that Sheet
Dim oAssemblyDoc As Document
Set oAssemblyDoc = oView.ReferencedDocumentDescriptor.ReferencedDocument
'Verify that the selected drawing view is of an assembly.
If oAssemblyDoc.DocumentType <> kAssemblyDocumentObject Then
Call MsgBox("The selected View must be of an assembly", vbInformation, "Document Type")
BCheck = False
Exit Sub
End If
' 5- Find the assigned Attribute of an Object
Dim sAttributeSetName As String
Dim sAttributeName As String
sAttributeSetName = "Balloon"
sAttributeName = AttributeName
Dim oObjs As ObjectCollection
Set oObjs = oAssemblyDoc.AttributeManager _
.FindObjects(sAttributeSetName, sAttributeName)
' Verify the existance of the assigned attribute
If oObjs.Count = 0 Then
Call MsgBox("attribute name " & sAttributeName & _
" was not found. Exiting.", vbCritical, "Attribute object")
BCheck = False
Exit Sub
End If
' 6- get the needed face of the object
Dim oTypeName As String
oTypeName = TypeName(oObjs.Item(1))
Dim oFace As Face
Dim oFaceProxy As FaceProxy
Dim oOccName As String
If oTypeName = "Face" Then
Set oFace = oObjs.Item(1)
oOccName = oFace.ContainingOccurrence.Name
ElseIf oTypeName = "FaceProxy" Then
Set oFaceProxy = oObjs.Item(1)
oOccName = oFaceProxy.ContainingOccurrence.Name
Else
Call MsgBox("the assigned object's Face was Not found. Exiting", vbCritical, "Face")
BCheck = False
Exit Sub
End If
GOccName = oOccName
' 7- get the occurrence of the detected object's face
Dim Oocc As ComponentOccurrence
Set Oocc = OccSearch(oAssemblyDoc)
' Verify the existance of the assigned occurrence
If Oocc Is Nothing Then
Call MsgBox("the Occurrence of the detected object is Not found. Exiting", vbCritical, "Occurrence")
BCheck = False
Exit Sub
End If
Dim oParentOcc As ComponentOccurrence
Set oParentOcc = Oocc.ParentOccurrence
If oTypeName = "Face" Then
Call Oocc.CreateGeometryProxy(oFace, oFaceProxy)
If Not oParentOcc Is Nothing Then
Call oParentOcc.CreateGeometryProxy(oFace, oFaceProxy)
End If
End If
' 8- Promote to an DrawingCurve on the View
Dim oViewAllCurves As DrawingCurvesEnumerator
Dim oViewCurves As DrawingCurvesEnumerator
Dim ocurve As DrawingCurve
Set oViewAllCurves = oView.DrawingCurves
For i = 1 To oViewAllCurves.Count
If oViewAllCurves.Item(i).StartPoint Is Nothing Or _
oViewAllCurves.Item(i).Evaluator3D Is Nothing Or _
oViewAllCurves.Item(i).ModelGeometry Is Nothing Then
i = i + 1
Else
If oViewAllCurves.Item(i).ModelGeometry.ContainingOccurrence.Name = oOccName Then
Set oViewCurves = oView.DrawingCurves(oFaceProxy)
If oViewCurves.Count <> 0 Then
Set ocurve = oViewCurves.Item(1)
Exit For
Else
Set ocurve = oViewAllCurves.Item(i)
Exit For
End If
End If
End If
Next
' Verify the existance of the assigned Curve
If ocurve Is Nothing Then
Call MsgBox("Occurrence does not belong to the view. Exiting", vbExclamation, "View Refrence Documents")
BCheck = False
Exit Sub
End If
If oViewAllCurves.Count = 0 Then
Call MsgBox("No curves found in view. Exiting", vbExclamation, "Drawing Curves")
BCheck = False
Exit Sub
End If
' 9- locate a position for the text point of the Balloon
' this will be relative to the assigned curve
Dim oMidPoint As Point2d
Set oMidPoint = ocurve.MidPoint
Dim oTG As TransientGeometry
Set oTG = ThisApplication.TransientGeometry
Dim Xpos As Double
Dim Ypos As Double
Xpos = oMidPoint.x + xPosition
Ypos = oMidPoint.y + yPosition
Set oPoint = oTG.CreatePoint2d(Xpos, Ypos)
' Attach Balloon to the text point
Dim oLeaderPoint As ObjectCollection
Set oLeaderPoint = ThisApplication.TransientObjects _
.CreateObjectCollection
Call oLeaderPoint.Add(oPoint)
' 10- locate a leader point for the Balloon
Dim GI As GeometryIntent
Set GI = oSheet.CreateGeometryIntent(ocurve, intent)
Call oLeaderPoint.Add(GI)
' Deleting the dublicated Balloon if any
Dim K As Integer
K = oSheet.Balloons.Count ' Number of Balloons
Dim counter As Integer
counter = 0 ' Number of similar balloons
For i = 1 To K
While i < K
If oSheet.Balloons.Item(i).ParentView.Name = sViewName Then
If oSheet.Balloons.Item(i).Position.x = Xpos And _
oSheet.Balloons.Item(i).Position.y = Ypos Then
oSheet.Balloons.Item(i).Delete
K = K - 1
End If
End If
i = i + 1
Wend
Next
' Adding the Balloon
Dim oBalloon As Balloon
Set oBalloon = oSheet.Balloons.Add(oLeaderPoint)
' Deleting previously exsited balloon if any
Dim oBalloonItemNumber As String
oBalloonItemNumber = oBalloon.BalloonValueSets _
.Item(1).ItemNumber
K = oSheet.Balloons.Count ' Updated Number of Balloons
For i = 1 To K
While i < K
If oSheet.Balloons.Item(i).ParentView.Name = sViewName _
And oSheet.Balloons.Item(i).BalloonValueSets _
.Item(1).ItemNumber = oBalloonItemNumber _
And oSheet.Balloons.Item(i).Position.x <> Xpos And _
oSheet.Balloons.Item(i).Position.y <> Ypos Then
counter = counter + 1
If counter >= 1 Then
oSheet.Balloons.Item(i).Delete
K = K - 1
i = i - 1
End If
End If
i = i + 1
Wend
Next
BCheck = True
End Sub
Function OccSearch(AssemblyDoc As AssemblyDocument) As ComponentOccurrence
Dim CompName As String
For Each SubCompOcc In AssemblyDoc.ComponentDefinition.Occurrences
CompName = SubCompOcc.Name
If CompName = GOccName Then
Set OccSearch = SubCompOcc
Exit Function
End If
If SubCompOcc.Visible = True And _
SubCompOcc.Suppressed = False And _
SubCompOcc.BOMStructure = kNormalBOMStructure And _
SubCompOcc.DefinitionDocumentType = kAssemblyDocumentObject Then
Set OccSearch = OccSearch(SubCompOcc.Definition.Document)
If Not OccSearch Is Nothing Then
Exit Function
End If
End If
Next
Set OccSearch = Nothing
End FunctionI hope everyone finds it useful.
Thanks