12-19-2019
06:52 AM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
12-19-2019
06:52 AM
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