- 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)