- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
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
Solved! Go to Solution.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
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.
=====
Hideo Yamada
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
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
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
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
=====
Hideo Yamada
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
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
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
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
=====
Hideo Yamada