Announcements
Attention for Customers without Multi-Factor Authentication or Single Sign-On - OTP Verification rolls out April 2025. Read all about it here.

Hi,

 


@mostafamahmoudseddek94 wrote:

sorry for replying late and thank you so much for helping me out of this, the code works fine but when I tried this code with another assembly file that contains a subassembly in which I would like to refer to the edge of one of the components of that subassembly called " DIN 50x5:26".

when I debug the code, it shows an error when it executes the line that creates a proxy! 


Nested assembly (sub assembly) is supported now!

 

Capture.PNG

 

Option Explicit

Private oDrawDoc As DrawingDocument
Private oSheet As Sheet
Private oView As DrawingView
Private oAssembly As AssemblyDocument

Public Sub CreatAssemblyDim()
    If Not InitializeCondition Then
        MsgBox "Failed : InitializeCondition"
        Exit Sub
    End If
    
    Dim aOccPath(10) As String
    
    Dim oOccCover As ComponentOccurrence
    aOccPath(1) = "Hopper_InspectionDoor_Cover:1"
    aOccPath(2) = ""
    Set oOccCover = GetOccurrenceByOccurrenceName(oAssembly, aOccPath)
    
    Dim oOccPlate As ComponentOccurrence
    aOccPath(1) = "DIN 50x5:26"
    aOccPath(2) = "Hopper_InspectionDoor_Plate:1"
    aOccPath(3) = ""
    Set oOccPlate = GetOccurrenceByOccurrenceName(oAssembly, aOccPath)
    
    If oOccCover Is Nothing Or oOccPlate Is Nothing Then
        MsgBox "The occurrence is not found."
        Exit Sub
    End If
        
    'promote to a geometryIntent on the sheet
    Dim GI1 As GeometryIntent
    Set GI1 = CreateGeometryIntent(oView, oOccCover, "Left")
    
    Dim GI2 As GeometryIntent
    Set GI2 = CreateGeometryIntent(oView, oOccPlate, "Right")
    
    'Create a general Dimension on that shett
    Dim oGeneralDims As GeneralDimensions
    Set oGeneralDims = oSheet.DrawingDimensions.GeneralDimensions
    
    ' Create point for the text
    Dim TextPoint As Point2d
    Dim Xpo As Double
    Dim Ypo As Double
    Xpo = oView.Left + (oView.Width / 4)
    Ypo = oView.Top + 3
    Set TextPoint = ThisApplication.TransientGeometry.CreatePoint2d(Xpo, Ypo)
    ' Create the Dimemsion
    Dim oDim1 As GeneralDimension
    Set oDim1 = oGeneralDims.AddLinear(TextPoint, GI1, GI2)
    For Each oDim1 In oGeneralDims
        If oDim1.Attached = False Then
            Call oDim1.Delete
        End If
    Next
End Sub

Private Function InitializeCondition() As Boolean
    InitializeCondition = False
    
    If TypeOf ThisApplication.ActiveDocument Is DrawingDocument Then
        Set oDrawDoc = ThisApplication.ActiveDocument
    Else
        Exit Function
    End If
    
    Set oSheet = oDrawDoc.ActiveSheet
    If oSheet Is Nothing Then
        Exit Function
    End If
    
    If oSheet.DrawingViews.Count > 0 Then
        Set oView = oSheet.DrawingViews(1)
    Else
        Exit Function
    End If
    
    Set oAssembly = oView.ReferencedDocumentDescriptor.ReferencedDocument
        
    InitializeCondition = True
End Function

Private Function GetOccurrenceByOccurrenceName(adoc As AssemblyDocument, ByRef aOccPath() As String) As ComponentOccurrence
    Dim occ As ComponentOccurrence
    Dim oOccs As ComponentOccurrences: Set oOccs = adoc.ComponentDefinition.Occurrences
    Dim occName As Variant
    Dim index As Integer: index = 1
    While index > 0
        Dim found As Boolean: found = False
        For Each occ In oOccs
            If occ.name = aOccPath(index) Then
                Set GetOccurrenceByOccurrenceName = occ
                found = True
                Exit For
            End If
        Next occ
        If found Then
            Set oOccs = GetOccurrenceByOccurrenceName.SubOccurrences
            index = index + 1
            If aOccPath(index) = "" Then index = -1
        Else
            Set GetOccurrenceByOccurrenceName = Nothing
            index = -1
        End If
    Wend
End Function

Private Function CreateGeometryIntent(oDrawingView As DrawingView, occ As ComponentOccurrence, labelName As String) As GeometryIntent
    Dim doc As Document
    Set doc = occ.Definition.Document
    
    Dim obj As Object
    Set obj = doc.AttributeManager.FindObjects(, , labelName).Item(1)
    
    Dim proxy As Object
    Call occ.CreateGeometryProxy(obj, proxy)
    
    Dim oDrawingCurve As DrawingCurve
    Set oDrawingCurve = oDrawingView.DrawingCurves(proxy).Item(1)
    
    Set CreateGeometryIntent = oView.Parent.CreateGeometryIntent(oDrawingCurve)
End Function

 

=====

Freeradical

 Hideo Yamada

=====
Freeradical
 Hideo Yamada
https://www.freeradical.jp