help with modifying my code

[mostafamahmoudseddek94]

Hi, the problem that I face is to have an automated Assembly Drawings for the master assembly that I made in which there are a lot of configurations for it. (bag filter) 

Dimensions that specifying -for example- the stiffeners spacing is deleted when I configure the master assembly to a different one.

I used the attribute to name the edges of a part in the assembly and I have written a code to add the dimension that I need on the assembly Drawing, the code works fine but I need to modify it so instead of specifying the number of the wanted item " item(1) for example" I would like to input the name of the item and the code  search and  return the item number, this because when I configure the master assembly, the number of the wanted item is changed and its occurrence item number is also changed.

Sub CreatAssemblyDim()
' refer to the file
Dim oDrawDoc As DrawingDocument
Set oDrawDoc = ThisApplication.ActiveDocument

'refer to the active sheet
Dim oSheet As Sheet
Set oSheet = oDrawDoc.ActiveSheet

'refer to the view
Dim oView As DrawingView
Set oView = oSheet.DrawingViews.Item(1)

'refer to the assembly on the view
Dim oAssembly As AssemblyDocument
Set oAssembly = oView.ReferencedDocumentDescriptor.ReferencedDocument

'find the model referenced  in the assembly
'Dim i As Integer
'For i = 1 To oAssembly.ReferencedDocuments.Count
Dim oModelDoc As Document
Set oModelDoc = oAssembly.ReferencedDocuments.Item(2)
' refer to the edge
Dim Edge1 As Edge
'MsgBox (oModelDoc.DisplayName)
Set Edge1 = oModelDoc.AttributeManager.FindObjects("*", "*", "Left").Item(1)

Dim Edge2 As Edge
Set Edge2 = oModelDoc.AttributeManager.FindObjects("*", "*", "Right").Item(1)

'Next
' refere to occurrence in the assembly
Dim oCompOcc As ComponentOccurrence
For Each occurrence In oAssembly.ComponentDefinition.Occurrences
'becouse there's only one occurrence
Set oCompOcc = oAssembly.ComponentDefinition.Occurrences.Item(1)


' promote the model edge to the assembly using poroxy
Dim oOccEdge1Proxy As EdgeProxy
Dim oOccEdge2Proxy As EdgeProxy

Call oCompOcc.CreateGeometryProxy(Edge1, oOccEdge1Proxy)
Call oCompOcc.CreateGeometryProxy(Edge2, oOccEdge2Proxy)

Next

'promote to an a DrawingCurve on the view
Dim oDrawingCurves1 As DrawingCurve
Set oDrawingCurves1 = oView.DrawingCurves(oOccEdge1Proxy).Item(1)

Dim oDrawingCurves2 As DrawingCurve
Set oDrawingCurves2 = oView.DrawingCurves(oOccEdge2Proxy).Item(1)

'promote to a geometryIntent on the sheet
Dim GI1 As GeometryIntent
Set GI1 = oSheet.CreateGeometryIntent(oDrawingCurves1)

Dim GI2 As GeometryIntent
Set GI2 = oSheet.CreateGeometryIntent(oDrawingCurves2)

'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

[HideoYamada]

Hi,

I changed your code and this code tries to add the dimension to the part which part number is same to the name specified in "targetPartName".

Option Explicit

Const targetPartName = "Part1"

Sub CreatAssemblyDim()
    ' refer to the file
    Dim oDrawDoc As DrawingDocument
    Set oDrawDoc = ThisApplication.ActiveDocument
    
    'refer to the active sheet
    Dim oSheet As Sheet
    Set oSheet = oDrawDoc.ActiveSheet
    
    'refer to the view
    Dim oView As DrawingView
    Set oView = oSheet.DrawingViews.Item(1)
    
    'refer to the assembly on the view
    Dim oAssembly As AssemblyDocument
    Set oAssembly = oView.ReferencedDocumentDescriptor.ReferencedDocument
    
    'find the model referenced  in the assembly
    Dim oTargetOcc As ComponentOccurrence ': Set oTargetOcc = Nothing
    Dim oOcc As ComponentOccurrence
    For Each oOcc In oAssembly.ComponentDefinition.Occurrences
        If TypeOf oOcc.Definition Is PartComponentDefinition Then
            If oOcc.Definition.Document.PropertySets("Design Tracking Properties")("Part Number").Value = targetPartName Then
                Set oTargetOcc = oOcc
                Exit For
            End If
        End If
    Next oOcc
    
    If oTargetOcc Is Nothing Then
        MsgBox "The occurrence named """ & targetPartName & """ is not exist."
        Exit Sub
    End If
    
    'Dim i As Integer
    'For i = 1 To oAssembly.ReferencedDocuments.Count
    Dim oModelDoc As Document
    Set oModelDoc = oTargetOcc.Definition.Document
    ' refer to the edge
    Dim Edge1 As Edge
    'MsgBox (oModelDoc.DisplayName)
    Set Edge1 = oModelDoc.AttributeManager.FindObjects("*", "*", "Left").Item(1)
    
    Dim Edge2 As Edge
    Set Edge2 = oModelDoc.AttributeManager.FindObjects("*", "*", "Right").Item(1)
    
    'Next
    ' refere to occurrence in the assembly
    Dim oCompOcc As ComponentOccurrence
    Set oCompOcc = oTargetOcc
    
    
    ' promote the model edge to the assembly using poroxy
    Dim oOccEdge1Proxy As EdgeProxy
    Dim oOccEdge2Proxy As EdgeProxy
    
    Call oCompOcc.CreateGeometryProxy(Edge1, oOccEdge1Proxy)
    Call oCompOcc.CreateGeometryProxy(Edge2, oOccEdge2Proxy)
    
    'promote to an a DrawingCurve on the view
    Dim oDrawingCurves1 As DrawingCurve
    Set oDrawingCurves1 = oView.DrawingCurves(oOccEdge1Proxy).Item(1)
    
    Dim oDrawingCurves2 As DrawingCurve
    Set oDrawingCurves2 = oView.DrawingCurves(oOccEdge2Proxy).Item(1)
    
    'promote to a geometryIntent on the sheet
    Dim GI1 As GeometryIntent
    Set GI1 = oSheet.CreateGeometryIntent(oDrawingCurves1)
    
    Dim GI2 As GeometryIntent
    Set GI2 = oSheet.CreateGeometryIntent(oDrawingCurves2)
    
    '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

I cannot understand exactly what you are needing, but I am grad if this code will help you to solve your problem.

=====

Freeradical

 Hideo Yamada

[mostafamahmoudseddek94]

Thanks for your code, you mean by "Part1" is the name of the occurrence in the design tree or the name of the file in the project directory? 

I am trying to refer to specific ( part, occurrence) in the assembly automatically not by selecting its item number from the Watch window but rather to search for that occurrence for me  ( see my new code)

Sub ADDHingeDimension()

' refer to the file
Dim oDrawDoc As DrawingDocument
Set oDrawDoc = ThisApplication.ActiveDocument

' refer to the sheet
Dim oSheet As Sheet
Set oSheet = oDrawDoc.Sheets.Item(1)

'refer to the View
Dim oView As DrawingView
Set oView = oSheet.DrawingViews.Item(1)

'refer to refrenced Assembly
Dim oAssembly As AssemblyDocument
Set oAssembly = oView.ReferencedDocumentDescriptor.ReferencedDocument

'refer the the Model in the Assembly
Dim i As Integer
For i = 1 To oAssembly.AllReferencedDocuments.Count
Dim oModelDoc As Document
Set oModelDoc = oAssembly.ReferencedDocuments.Item(i)

'refer to the Edge on the Model
If oModelDoc.DisplayName = "Hopper_InspectionDoor_cover.ipt" Then
Set oModelDoc = oAssembly.ReferencedDocuments.Item(i)
Dim Edge2 As Edge
Set Edge2 = oModelDoc.AttributeManager.FindObjects("*", "*", "Door_Left").Item(1)
Exit For
ElseIf oModelDoc.DisplayName = "Hopper_InspectionDoor_Plate.ipt" Then
Set oModelDoc = oAssembly.ReferencedDocuments.Item(i)
Dim Edge1 As Edge
Set Edge1 = oModelDoc.AttributeManager.FindObjects("*", "*", "Plate_Type1_Left").Item(1)
 
End If
Next

' refer to occurrance in the assembly
Dim j As Integer
For j = 1 To oAssembly.ComponentDefinition.Occurrences.Count
Dim oOcc As ComponentOccurrence
Dim oOcc1 As ComponentOccurrence
Dim oOcc2 As ComponentOccurrence
Set oOcc = oAssembly.ComponentDefinition.Occurrences.Item(j)

If oOcc.Name = "Hopper_InspectionDoor_Door:1" Then
Set oOcc2 = oAssembly.ComponentDefinition.Occurrences.Item(j)

ElseIf oOcc.Name = "Hopper_InspectionDoor_Plate:2" Then
Set oOcc1 = oAssembly.ComponentDefinition.Occurrences.Item(j)

Exit For
End If
Next

' promot edge to proxy
Dim oproxy1 As EdgeProxy
  Call oOcc1.CreateGeometryProxy(Edge1, oproxy1)
Dim oproxy2 As EdgeProxy
  Call oOcc2.CreateGeometryProxy(Edge2, oproxy2)
 
 ' promot proxy to Drawing curve
 Dim oCurve1 As DrawingCurve
 Set oCurve1 = oView.DrawingCurves(oproxy1).Item(1)
 
 Dim oCurve2 As DrawingCurve
 Set oCurve2 = oView.DrawingCurves(oproxy2).Item(1)

of course, my code is incomplete and the last line introduces error to me I do not why, in the Watch Window,  the Variable called "oView.DrawingCurves(oproxy2)" contains no items  see below 

  what I really like to do is to place a dimension between two different parts in the assembly ( inspection door)

see this view below 

[HideoYamada]

Hi,

This code will help you.

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 oOccCover As ComponentOccurrence
    Dim oOccPlate As ComponentOccurrence
    
    Set oOccCover = GetOccurrenceByOccurrenceName(oAssembly, "Hopper_InspectionDoor_Cover:1")
    Set oOccPlate = GetOccurrenceByOccurrenceName(oAssembly, "Hopper_InspectionDoor_Plate:1")
    
    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, occName As String) As ComponentOccurrence
    Dim occ As ComponentOccurrence
    For Each occ In adoc.ComponentDefinition.Occurrences
        If occ.name = occName Then
            Set GetOccurrenceByOccurrenceName = occ
            Exit For
        End If
    Next occ
End Function

Private Function GetOccurrenceByPartNumber(adoc As AssemblyDocument, partNumberString As String) As ComponentOccurrence
    Dim occ As ComponentOccurrence
    For Each occ In adoc.ComponentDefinition.Occurrences
        If TypeOf occ.Definition Is PartComponentDefinition Then
            If occ.Definition.Document.PropertySets("Design Tracking Properties")("Part Number").Value = partNumberString Then
                Set GetOccurrenceByPartNumber = occ
                Exit For
            End If
        End If
    Next occ
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

[mostafamahmoudseddek94]

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! 

 thanks 

[HideoYamada · Accepted solution]

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!

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