Hi Jef,
I am a weirdo and a true result of globalisation. I am Romanian, working with Veolia Water Technologies in UK, and the drawing was done by a supplier in Nederlands for a job in Denmark :)) or something along those lines.
I needed the 3D model to incorporate it in my plant layout so they sent a STEP over. We are not Vessel designers but we do create tank drawings for quoting purposes. It just happen that the dutch model was close at hand.
I have finalized a version of the code but it can be changed to suit your needs.
Like I've mentioned before, I recommend that you create a new custom Balloon style ("Tag" in my code, maybe change it to "Nozzle" to make it more obvious and change shape to differentiate it) and you balloon as usual choosing "Tag" style (or change them all at the end) then run the code and watch the magic ( i wish, poor programing on my side :)) ).
If you don't create a custom style and balloon first you can mix match this with my original code and create balloons on the fly.
Try this out and let me know how that goes.
' Set a reference to the drawing document.
' This assumes a drawing document is active.
Dim oDrawDoc As DrawingDocument
oDrawDoc = ThisApplication.ActiveDocument
' Set a reference to the active sheet.
Dim oActiveSheet As Sheet
oActiveSheet = oDrawDoc.ActiveSheet
Dim oStyles As DrawingStylesManager
oStyles = oDrawDoc.StylesManager
Dim oCurve As DrawingCurve
Dim oEdge As EdgeProxy
Dim occurrence As ComponentOccurrence
'Dim oParentOcc As ComponentOccurrence
Dim oGeometryIntent As GeometryIntent
'----------Update existing balloons on all sheets
'Ask the user if he wants to update values of all balloons (if edited some)
booleanParam = InputRadioBox("Update existing balloons?: ", "Yes", "No", True, Title :="Update Existing?")
If booleanParam = False Then
Exit Sub
ElseIf booleanParam = True
'process all sheets
For Each oSheets In oDrawDoc.Sheets
' Iterate over each balloon on the sheet.
For Each oBalloon In oActiveSheet.Balloons
If oBalloon.Style.Name = "Tags" Then
Try
Dim leader As Leader
Leader = oBalloon.Leader
'assuming the leader is a single line segment
Dim leaderNode As LeaderNode
leaderNode = leader.AllNodes(2)
oGeometryIntent = leaderNode.AttachedEntity
curve = oGeometryIntent.Geometry
oEdge = curve.ModelGeometry
occurrence = oEdge.ContainingOccurrence
'-------------------------------------------
'MessageBox.Show("Leaf Occ name: " & occurrence.Name,"ilogic")
TestParent = True
While Not occurrence.ParentOccurrence Is Nothing
'MessageBox.Show("Parent Occ name: " & occurrence.ParentOccurrence.Name,"ilogic")
occurrence = occurrence.ParentOccurrence
'MessageBox.Show("cur Occ name: " & occurrence.Name,"ilogic")
End While 'end test for parent
' '-------------------------------------------
Retry = True
'as long as retry is selected by user
While Retry
'get tag from user
oTagOcc = InputBox("Enter Tag No: ", "Tag Prompt", occurrence.Name)
Try
' try and set that value
occurrence.Name = oTagOcc
'if success exit the retrying loop
Exit While
'if tag allready exists
Catch
'prompt if user wants to try again
Retry = InputRadioBox("Allready used, try again", "Yes", "No", Retry, Title := "Retry")
End Try
End While
'if user canceled the retry skip the rest of the code and
'prompt to select parts again
If Retry = False Then
'Continue While
Exit For
End If
' Iterate over each value set (attached balloons) in a balloon.
For Each oBalloonValueSet In oBalloon.BalloonValueSets
' Set balloon value from browser.
oBalloonValueSet.OverrideValue = occurrence.Name
Next 'go to next balloon
Catch'do nothing if error
End Try
End If 'end of search for Tags balloons
Next
Next
End If
'----------End Update existing balloons on all sheets
Adrian S.
blog.ads-sol.com
AIP2012-2020 i7 6700k AMD R9 370
Did you find this reply helpful ?
If so please use the Accepted Solutions or Like button - Thank you!