Hey Pradeep,
I have updated code so it now places the leaders outside the drawing view. Here's the updated code:
Imports Linq
Class ThisRule
' Created by James Collins
' Allows user to assign a colour and associated treatment to a face (model documents).
' Then display the treatment in the drawing via sketch symbols
' Doesn't check if there are any existing tags!
' This class will be used when we are adding sybols to the drawing
Class ColourTreatment
Public Treatment As String
Public ColourName As String
Public RALColourName As String
Public TagNumber As Double
End Class
' Create Dictionary of required colour treatment combinations
Dim colourTreatmentDict As New Dictionary(Of String, String())
' This list will be used to keep count of the treatments we can find in this view
Dim assignedColourTreatments As New List(Of ColourTreatment)
Dim treatmentSymbolDef As SketchedSymbolDefinition = Nothing
Dim TreatmentNameD As String = "Treatment"
Dim RALColourNameD As String = "RALColour"
Dim BasicColourNameD As String = "BasicColour"
Dim colourTreatmentSet As String = "colourTreatmentSet"
Dim treatmentSymbolName As String = "Treatment Tag"
Dim activeDoc As Document
Dim viewReferencedDocument As Document
Dim assyDocument As AssemblyDocument
Dim partDocument As partDocument
Dim drawDocument As DrawingDocument
Dim currentSheet As Sheet
Dim transObjects As TransientObjects
Dim transGeometry As TransientGeometry
Dim selectedTreatmentColour() As String
' Used for placement of symbols on drawing
Dim viewOffsetRectLines(3) As Object
'<<<<NEW 20221216 Create a box that defines the view extents
Dim viewRangeBox As Box2d '>>>>
Dim calculatedViewCenter As Point2d
Sub Main
assyDocument = TryCast(ThisApplication.ActiveDocument, AssemblyDocument)
drawDocument = TryCast(ThisApplication.ActiveDocument, DrawingDocument)
partDocument = TryCast(ThisApplication.ActiveDocument, partDocument)
activeDoc = ThisApplication.ActiveDocument
' Set a reference to the command manager
Dim oCommandMngr As CommandManager = ThisApplication.CommandManager
' Set references
transObjects = ThisApplication.TransientObjects
transGeometry = ThisApplication.TransientGeometry
If Not drawDocument Is Nothing Then
GoTo drawingFunctions
Else If Not assyDocument Is Nothing Then
Else If Not partDocument Is Nothing Then
Else
Exit Sub ' unknown doc type
End If
' <##### Hard code more colour treatment combinations below as required:
' The last three string values in each line represent the rgb values of the RAL colour
colourTreatmentDict.Add("GALVANISED", New String() {"GREEN", "RAL 6038", 0, 181, 26 })
colourTreatmentDict.Add("ZINC PLATED", New String() {"RED", "RAL 3024", 255, 45, 33 })
colourTreatmentDict.Add("HDG", New String() {"VIOLET", "RAL 4005", 118, 104, 154 })
' Hard code more colour treatment combinations Above ^ #####>
' Create a temp copy the we can use when assigning coulour to the model
Dim colourTratmentDictTemp As New Dictionary(Of String, String())(colourTreatmentDict)
Dim endSelection As String = "End Selection"
colourTratmentDictTemp.Add(endSelection, New String() {"", "", "", "", "" })
Dim selectedObject As Object
' Allows user to keep selecting desired treatment/faces
addAnotherTreatment :
Dim treatmentSelection As Object = InputListBox("Select Face Treatment", colourTratmentDictTemp.Keys, _
1, Title := "List of Treatments to add to faces", ListName := "Available Treatments:")
' Finish up if nothing is selected or endSelection is selected
If treatmentSelection Is Nothing Or treatmentSelection = endSelection Then GoTo finishSelection
' Get the string array of this dictionary item (treatmentSelection)
selectedTreatmentColour = colourTreatmentDict.Item(treatmentSelection)
' Basic colour Name based on treatment
Dim colourNameS As String = selectedTreatmentColour(0)
' RAL Colour
Dim RALColourNameS As String = selectedTreatmentColour(1)
' Remove the treatment, so the user is only left with treatments that havent been applied yet
colourTratmentDictTemp.Remove(treatmentSelection)
' Allow user to add colour/treatment to faces
If treatmentSelection <> endSelection Then
While True
'Select faces
selectedObject = oCommandMngr.Pick(SelectionFilterEnum.kAllEntitiesFilter, _
"Select Faces to Add Treatment to. Hit Esc when Done.")
' Finish command if nothing is selected
If IsNothing(selectedObject) Then
If colourTratmentDictTemp.Count = 1 Then GoTo finishSelection
GoTo addAnotherTreatment
Exit While
End If
Call SetFaceColour(selectedObject, treatmentSelection, colourNameS, RALColourNameS)
End While
End If
finishSelection :
' If this is a part/assembly then exit sub
If drawDocument Is Nothing Then Exit Sub
' Drawing only stuff
drawingFunctions :
' Select View to get all faces with Colour/Treatments
' Get the collection of control definitions
Dim selectedView As Object
' Get user to select a drawing view to add the symbol to
selectedView = oCommandMngr.Pick(SelectionFilterEnum.kDrawingViewFilter, _
"Select View to Tag Treatment Faces")
If selectedView Is Nothing Then
MessageBox.Show("Select a Drawing View Next Time!" & vbLf & _
"", "ERROR", MessageBoxButtons.OK, MessageBoxIcon.Error)
Exit Sub
End If
viewReferencedDocument = selectedView.ReferencedDocumentDescriptor.ReferencedDocument
currentSheet = drawDocument.ActiveSheet
' Create a dictionary to store the Faces
Dim requiredFacesDict As New Dictionary(Of Object, Object())
Call DistinctOccurrences(selectedView, requiredFacesDict)
Logger.Info("DistinctOccurrences passed")
If requiredFacesDict.Count = 0 Then
MessageBox.Show("Treatments Must be Assigned to the Model" & vbLf & _
"Before Running this Rule in the Drawing!", "ERROR", MessageBoxButtons.OK, MessageBoxIcon.Error)
Exit Sub
End If
' Creates a rectangle around view to place leader/sketch symbols on
Call ViewOffsetRectangle(selectedView, requiredFacesDict.Count)
' Create a new transaction to wrap these drawing functions into
Dim drawingTrans As Transaction = ThisApplication.TransactionManager.StartTransaction( _
drawDocument, "Treatment Symbols")
Call GetViewOccurrenceDocument(selectedView, requiredFacesDict)
If treatmentSymbolDef Is Nothing Then
Exit Sub
End If
Call AddLegendSymbolsToDrawing()
'<<<<NEW 20221216 Added to ensure view is set to shaded
If selectedView.ViewStyle <> DrawingViewStyleEnum.kShadedDrawingViewStyle Then
Try
selectedView.ViewStyle = DrawingViewStyleEnum.kShadedDrawingViewStyle
Catch
Logger.Info("Unable to set View Style to Shaded!")
End Try
End If '>>>>
' End the transaction for the drawing funtions.
drawingTrans.End
End Sub
Public Sub SetFaceColour(ByRef selectedObject As Object, ByRef treatmentSelection As Object, _
ByRef colourNameS As String, ByRef RALColourNameS As String)
If TypeName(selectedObject) Like "Face*" Then
Dim oFace As Face
Dim faceDoc As partDocument
If partDocument Is Nothing Then 'its an assembly
Logger.Info("assy doc")
oFace = selectedObject.NativeObject
Call GetFaceDocument(oFace, faceDoc)
Else ' Its a part
oFace = selectedObject
faceDoc = activeDoc
End If
Dim docAssets As Assets = faceDoc.Assets
Dim foundAsset As Boolean
For Each docAsset As Asset In docAssets
If docAsset.DisplayName = colourNameS Then
Logger.Info("docAsset.DisplayName: " & docAsset.DisplayName)
foundAsset = True
Exit For
End If
Next
If foundAsset = False Then
Dim newAsset As Asset = docAssets.Add(kAssetTypeAppearance, "Generic", , colourNameS)
Dim colourAssetVal As ColorAssetValue = newAsset.Item("generic_diffuse")
Dim colourR As Byte = selectedTreatmentColour(2)
Dim colourG As Byte = selectedTreatmentColour(3)
Dim colourB As Byte = selectedTreatmentColour(4)
Logger.Info("RGB: " & colourR & "," & colourG & "," & colourB)
colourAssetVal.Value = transObjects.CreateColor(colourR, colourG, colourB)
End If
' Create a new transaction to wrap the modification to this file into a single undo.
Dim trans As Transaction = ThisApplication.TransactionManager.StartTransaction( _
faceDoc, "Treatment Colour")
' Set the face colour
Call oFace.SetRenderStyle(kOverrideRenderStyle, faceDoc.RenderStyles.Item(colourNameS))
' We will store the treatment information in the face attributes
Call CreateAttributes(oFace, treatmentSelection, colourNameS, RALColourNameS)
' End the transaction for the previous two actions
trans.End
End If
End Sub
Public Sub GetFaceDocument(ByRef selectedFace As Object, ByRef selectedFaceDoc As partDocument)
' Get the document that this face belongs to
Logger.Info("face parent: " & TypeName(selectedFace.Parent))
If TypeName(selectedFace.Parent) = "PartComponentDefinition" Then
Logger.Info(selectedFace.Parent.Document.FullDocumentName)
selectedFaceDoc = selectedFace.Parent.Document
Else
Logger.Info("calling function again")
Call GetFaceDocument(selectedFace.Parent, selectedFaceDoc)
End If
End Sub ']
Public Sub CreateAttributes(ByRef oFace As Face, ByRef treatmentSelection As Object, ByRef colourNameS As String, ByRef RALColourNameS As String)
' Stores information about the treatment and colour in the faces attribute set
Logger.Info("about to creat atts")
Dim attSets As AttributeSets = oFace.AttributeSets
Dim attSet As AttributeSet
Dim attNamesDict As New Dictionary(Of String, Object)
attNamesDict.Add(TreatmentNameD, treatmentSelection)
attNamesDict.Add(RALColourNameD, RALColourNameS)
attNamesDict.Add(BasicColourNameD, colourNameS)
If attSets.NameIsUsed(colourTreatmentSet) = False Then 'create it for the first time
attSet = attSets.Add(colourTreatmentSet)
Else
attSet = attSets.Item(colourTreatmentSet)
End If
' Use For Each loops over pairs not found earlier and add as atts
For Each pair As KeyValuePair(Of String, Object) In attNamesDict
Dim attName As String = pair.Key
Dim attValue As String = pair.Value
If attSet.NameIsUsed(attName) = False Then 'create it for the first time
att = attSet.Add(attName, kStringType, attValue)
Else ' already exists
att = attSet.Item(attName)
att.Value = attValue
End If
Next
End Sub
Public Sub DistinctOccurrences(ByVal drgView As DrawingView, ByVal requiredFacesDict As Dictionary(Of Object, Object()))
' Loop through all of the curves in the view to find distinct occurrences that contain faces with treatment attributes (coloured faces)
Dim selectedViewCurves As DrawingCurvesEnumerator = drgView.DrawingCurves
' Loop through the curves to get unique part file instances
For Each selectedViewCurve As DrawingCurve In selectedViewCurves
If selectedViewCurve.ModelGeometry Is Nothing = True Then Continue For
Try
Dim modelGeo As Object = selectedViewCurve.ModelGeometry
Dim containingOcc As ComponentOccurrence
Dim containingOccDefType As DocumentTypeEnum
Dim partDoc As partDocument
Dim modelGeoFaces As Faces
' Part doc so we can access the face directly
If viewReferencedDocument.DocumentType = DocumentTypeEnum.kPartDocumentObject Then
modelGeoFaces = modelGeo.Faces
For Each nativeFace As Face In modelGeoFaces
Dim hasAttSet As Boolean = nativeFace.AttributeSets.NameIsUsed(colourTreatmentSet)
If hasAttSet = False Then Continue For
If requiredFacesDict.ContainsKey(nativeFace) Then Continue For
requiredFacesDict.Add(nativeFace, New Object() {selectedViewCurve, Nothing})
Next
Else ' Assembly document, faceproxy is used to access native face object
containingOcc = modelGeo.ContainingOccurrence
containingOccDefType = containingOcc.DefinitionDocumentType
If containingOccDefType = DocumentTypeEnum.kPartDocumentObject Then
Logger.Info("###" & containingOcc.Name)
partDoc = containingOcc.Definition.Document
modelGeoFaces = modelGeo.Faces
For Each modelGeoFace As FaceProxy In modelGeoFaces
Dim nativeFace As Face = modelGeoFace.NativeObject
' Only continue if it contains desired attribute set
Dim hasAttSet As Boolean = nativeFace.AttributeSets.NameIsUsed(colourTreatmentSet)
If hasAttSet = False Then Continue For
If requiredFacesDict.ContainsKey(nativeFace) Then Continue For
' containing occurrence may be better than doc as we want to check this occ against the model occ
requiredFacesDict.Add(nativeFace, New Object() {selectedViewCurve, containingOcc })
Next
End If
End If
Catch
Continue For
End Try
Next
End Sub
Public Sub ViewOffsetRectangle(ByVal selectedView As DrawingView, ByVal requiredFacesDictCount As Integer)
' Create a rectangle offset from the view perimeter that will be used to place the sketch symbols on
' that will intersect with the rectangle
' and then we can use those intersection points to place the symbols on
Dim viewHeight As Double = selectedView.Height
Dim viewWidth As Double = selectedView.Width
Dim viewLeft As Double = selectedView.Left
Dim viewTop As Double = selectedView.Top
Dim viewOffset As Double = 2
' Want to make sure that we get the actual view center, as the view.center and view.position tend to differ...
calculatedViewCenter = transGeometry.CreatePoint2d(viewLeft + viewWidth / 2, viewTop - viewHeight / 2)
' Create the rangebox points of the rectangle
Dim viewExtentsOffsetBoxMinPoint As Point2d = transGeometry.CreatePoint2d(viewLeft - viewOffset, viewTop - viewHeight - viewOffset)
Logger.Info("viewExtentsOffsetBoxMinPoint XY: " & viewExtentsOffsetBoxMinPoint.X & ", " & viewExtentsOffsetBoxMinPoint.Y)
Dim viewExtentsOffsetBoxMaxPoint As Point2d = transGeometry.CreatePoint2d(viewLeft + viewWidth + viewOffset, viewTop + viewOffset)
Logger.Info("viewExtentsOffsetBoxMaxPoint XY: " & viewExtentsOffsetBoxMaxPoint.X & ", " & viewExtentsOffsetBoxMaxPoint.Y)
' These are the lines that will define the rectange
Dim viewOffsetRectLine1, viewOffsetRectLine2, viewOffsetRectLine3, viewOffsetRectLine4 As LineSegment2d
viewOffsetRectLine1 = transGeometry.CreateLineSegment2d(viewExtentsOffsetBoxMinPoint, _
transGeometry.CreatePoint2d(viewExtentsOffsetBoxMinPoint.X, viewExtentsOffsetBoxMaxPoint.Y))
viewOffsetRectLine2 = transGeometry.CreateLineSegment2d(viewOffsetRectLine1.EndPoint, viewExtentsOffsetBoxMaxPoint)
viewOffsetRectLine3 = transGeometry.CreateLineSegment2d(viewExtentsOffsetBoxMaxPoint, _
transGeometry.CreatePoint2d(viewExtentsOffsetBoxMinPoint.Y, viewExtentsOffsetBoxMaxPoint.X))
viewOffsetRectLine4 = transGeometry.CreateLineSegment2d(viewOffsetRectLine3.EndPoint, viewOffsetRectLine1.StartPoint)
' Add the lines to this array for later use
viewOffsetRectLines(0) = viewOffsetRectLine1 : viewOffsetRectLines(1) = viewOffsetRectLine2 : viewOffsetRectLines(2) = viewOffsetRectLine3 : viewOffsetRectLines(3) = viewOffsetRectLine4
'<<<<NEW 20221216 These are the points that define the view
Dim viewMaxPoint = New Double() {viewLeft + viewWidth, viewTop}
Dim viewMinPoint = New Double() {viewLeft, viewTop - viewHeight}
' Create the box
viewRangeBox = transGeometry.CreateBox2d()
' Set the data the defines the box
viewRangeBox.PutBoxData(viewMinPoint, viewMaxPoint) '>>>>
End Sub
' Not a great implementation, often the symbol isn't placed on the rectangle.
' Take a look at this post if you want something more reliable: https://forums.autodesk.com/t5/inventor-ilogic-and-vb-net-forum/auto-ballooning-a-drawing-attach-balloon-to-drawingcurvesegment/m-p/10096249
Public Function LeaderViewRectIntersection(ByRef geoIntentPoint As Point2d) As Point2d
' Create mathematical points at the intersection of the curve geometry and the view offset rectangle
Dim viewCentertoGeoIntentLine As LineSegment2d = transGeometry.CreateLineSegment2d(calculatedViewCenter, geoIntentPoint)
Dim intPoints As ObjectCollection = Nothing
intPoints = transObjects.CreateObjectCollection
Dim intPointsCount As Double = 0
' Define this first one as 0,0 just in case it we dont find any intersections
Dim intPoint As Point2d = transGeometry.CreatePoint2d(0, 0)
' Loop through the rectanglular lines and see if they intersect with any of the drawing curves
For i = 0 To viewOffsetRectLines.Count - 1
Dim viewOffsetRectLine As LineSegment2d = viewOffsetRectLines(i)
Logger.Info(TypeName(viewOffsetRectLine))
Dim intersectingpoints As ObjectsEnumerator
' Setting the Tolerance to 0 or 1 didnt provide very good results, so I bumped it to 10
' intersectingpoints = viewOffsetRectLine.IntersectWithCurve(viewCentertoGeoIntentLine, 1)
intersectingpoints = viewCentertoGeoIntentLine.IntersectWithCurve(viewOffsetRectLine, 10)
If intersectingpoints Is Nothing Then
Logger.Info("nothing")
Continue For
Else
' Set as the first intersection point
intPoint = intersectingpoints.Item(1)
For Each intersectingpointsPoint In intersectingpoints
' But also add the rest so we can get the closest one
intPoints.Add(intersectingpointsPoint)
Logger.Info("intersectingpointsPointXY: " & intersectingpointsPoint.X & ", " & intersectingpointsPoint.Y)
Next
End If
i += 1
Next
' ####<If you want to see this visually uncomment the lines below
' Dim oSketch As DrawingSketch = drawDocument.ActiveSheet.Sketches.Add
' ' Put the sketch in edit mode
' oSketch.Edit
' Call oSketch.SketchLines.AddByTwoPoints(viewCentertoGeoIntentLine.StartPoint, viewCentertoGeoIntentLine.EndPoint)
' Call oSketch.SketchLines.AddAsTwoPointRectangle(transGeometry.CreatePoint2d(viewOffsetRectLines(0).StartPoint.X, viewOffsetRectLines(0).StartPoint.Y), transGeometry.CreatePoint2d(viewOffsetRectLines(1).EndPoint.X, viewOffsetRectLines(1).EndPoint.Y))
' oSketch.ExitEdit
'####>
' Loop over all of the points to see which one is the closest
' Should probably have checked to see if point is inside rectangle with something like this : https://stackoverflow.com/questions/2752725/finding-whether-a-point-lies-inside-a-rectangle-or-not
For Each finalPoint As Point2d In intPoints
Logger.Info("A: " & finalPoint.DistanceTo(viewCentertoGeoIntentLine.EndPoint) & ", B: " & intPoint.DistanceTo(viewCentertoGeoIntentLine.EndPoint))
If finalPoint.DistanceTo(viewCentertoGeoIntentLine.EndPoint) < intPoint.DistanceTo(viewCentertoGeoIntentLine.EndPoint) Then
'<<<<NEW 20221216 Make sure the point doesn't reside in the view >>>>
If viewRangeBox.Contains(intPoint) Then Continue For
intPoint = finalPoint
End If
Next
Return intPoint
End Function
Public Function GetSketchSymbol()
' Return the required symbol, if it exists
Dim sketchSymbolDefs As SketchedSymbolDefinitions = drawDocument.SketchedSymbolDefinitions
For Each sketchSymbolDef As SketchedSymbolDefinition In sketchSymbolDefs
If sketchSymbolDef.Name = treatmentSymbolName Then
treatmentSymbolDef = sketchSymbolDef
Return treatmentSymbolDef
End If
Next
End Function
Public Sub GetViewOccurrenceDocument(ByVal drgView As DrawingView, _
ByRef requiredFacesDictionary As Dictionary(Of Object, Object()))
' Get View Occurrence/Document
Dim viewDocCompDef As ComponentDefinition = viewReferencedDocument.ComponentDefinition
Dim taggedEdges As New ArrayList
Dim taggedFaces As New ArrayList
' Get the required symbol, if it exists
treatmentSymbolDef = GetSketchSymbol()
If treatmentSymbolDef Is Nothing Then
MessageBox.Show("Cannot Find Sketch Symbol (" & treatmentSymbolName & ")" & vbLf & _
"Add it to the Drawing Before Running this Rule Again", "NO SYMBOL", MessageBoxButtons.OK, MessageBoxIcon.Error)
Exit Sub
End If
Dim assignedTreatmentCount As Double = 1
For Each requiredFace In requiredFacesDictionary
' Get the string array of this dictionary item
Dim requiredFaceObjs() As Object = requiredFacesDictionary.Item(requiredFace.Key)
' Probably the first edge associated with the face
Dim viewCurve As DrawingCurve = requiredFaceObjs(0)
Dim modelDoc As Document
' Part doc so we can access the face directly
If viewReferencedDocument.DocumentType = DocumentTypeEnum.kPartDocumentObject Then
modelDoc = viewReferencedDocument
Call AddSymbolToView(modelDoc, drgView, taggedEdges, taggedFaces, assignedTreatmentCount, Nothing)
Else ' Assembly Document so we need to access the occurrences
' Occurrence that owns the face
Dim containingOccurrence As ComponentOccurrence = requiredFaceObjs(1)
' Loop through all of the occurrences of the occurrence document in this assembly
For Each possibleNewEntityOcc As ComponentOccurrence In _
viewDocCompDef.Occurrences.AllReferencedOccurrences(containingOccurrence.Definition.Document)
If possibleNewEntityOcc Is containingOccurrence Then
modelDoc = containingOccurrence.Definition.Document
Logger.Info(modelDoc.DisplayName)
Call AddSymbolToView(modelDoc, drgView, taggedEdges, taggedFaces, assignedTreatmentCount, possibleNewEntityOcc)
End If
Next
End If
Next
End Sub
Public Sub AddSymbolToView(ByRef modelDoc As Document, ByVal drgView As DrawingView, _
ByRef taggedEdges As ArrayList, ByRef taggedFaces As ArrayList, _
ByRef assignedTreatmentCount As Double, ByRef possibleNewEntityOcc As ComponentOccurrence)
' Add symbols to drawing view
Dim curveColl As ObjectCollection = Nothing
Dim drawingCurvesEnum As DrawingCurvesEnumerator = Nothing
Dim drawingCurve1 As DrawingCurve = Nothing
Dim edgeProxy1 As EdgeProxy = Nothing
Dim geoIntent As GeometryIntent = Nothing
Dim XPos, YPos As Double
Dim tempObject As Object = Nothing
Dim facesCollection As ObjectCollection = Nothing
' Only get the faces that have the correct attribute set
facesCollection = modelDoc.AttributeManager.FindObjects(colourTreatmentSet, , )
Logger.Info("facesCollection.Count: " & facesCollection.Count)
' Only loop over the faces that have the correct attribute set
For Each attFace As Face In facesCollection
' Use this to make sure we dont try to get this face again
Dim attFaceKey As Integer = attFace.TransientKey
Dim faceColourTreatmentAtts As AttributeSet = attFace.AttributeSets(colourTreatmentSet)
' Get the required Values from the attributes
Dim attTreatment As String = faceColourTreatmentAtts.Item(TreatmentNameD).Value
Dim attRALColour As String = faceColourTreatmentAtts.Item(RALColourNameD).Value
' Pass over any previously tagged faces
If taggedFaces.Contains(attFaceKey) Then Continue For
Logger.Info("attFaceKey: " & attFaceKey)
For Each attFaceEdge As Edge In attFace.Edges
Dim attFaceEdgeKey As Integer = attFaceEdge.TransientKey
' Pass over any that we already have
If taggedEdges.Contains(attFaceEdgeKey) Then Continue For
Logger.Info("attFaceEdgeKey: " & attFaceEdgeKey)
Dim geoIntentPoint As Point2d = Nothing
' This will fail for any edges that aren't visible
Try
' Assembly so we need to get edge via proxy
If viewReferencedDocument.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject Then
possibleNewEntityOcc.CreateGeometryProxy(attFaceEdge, tempObject)
edgeProxy1 = CType(tempObject, EdgeProxy)
drawingCurvesEnum = drgView.DrawingCurves(edgeProxy1)
Else ' Part doc so we can access the face directly
drawingCurvesEnum = drgView.DrawingCurves(attFaceEdge)
End If
' If the count is zero then this edge isnt visible in this view so skip it
If drawingCurvesEnum.Count = 0 Then Continue For
drawingCurve1 = drawingCurvesEnum(1)
geoIntent = currentSheet.CreateGeometryIntent(drawingCurve1, 0.5)
' This point will be used to place the sketch symbol
geoIntentPoint = geoIntent.PointOnSheet
Logger.Info("geoIntentPointXY: " & geoIntentPoint.X & ", " & geoIntentPoint.Y)
Catch E As Exception
Logger.Info(E.ToString())
Continue For
End Try
Try
' Find the closest point to geoIntent
Dim closestPoint As Point2d = Nothing
closestPoint = LeaderViewRectIntersection(geoIntentPoint)
Logger.Info("closestPointXY: " & closestPoint.X & ", " & closestPoint.Y)
' Create a collection for placement points of the symbol and its leader
curveColl = transObjects.CreateObjectCollection
' Leader point
curveColl.Add(closestPoint)
' Symbol Point
curveColl.Add(geoIntentPoint)
' This will be used to give each treatment a unique #
Dim tagNumber As Double = assignedTreatmentCount
' Check if the treatment already has an # associated with it
If assignedColourTreatments.Any(Function(ct) ct.Treatment = attTreatment) Then
' Get access to the object
Dim thisAttTreatment = assignedColourTreatments.FirstOrDefault(Function(cT) cT.Treatment = attTreatment)
' Assign the tag #
If Not thisAttTreatment Is Nothing Then tagNumber = thisAttTreatment.TagNumber
Else ' No associated number
assignedColourTreatments.Add(New ColourTreatment With {.Treatment = attTreatment, _
.RALColourName = attRALColour, .TagNumber = assignedTreatmentCount })
assignedTreatmentCount += 1
End If
' As this symbol will only have a tag # we will leave the second string empty
Dim promptStrings = New String() {tagNumber, "" }
' Add the symbol to the drawing
currentSheet.SketchedSymbols.AddWithLeader(treatmentSymbolDef, curveColl, 0, 1, promptStrings, True, True)
' Add this face edge to the arraylist so that we dont tag it twice
taggedEdges.Add(attFaceEdgeKey)
' Add this face to the arraylist so that we dont tag it twice
taggedFaces.Add(attFaceKey)
' Remove any values associated with these so we start fresh for next edge
curveColl = Nothing
drawingCurvesEnum = Nothing
drawingCurve1 = Nothing
edgeProxy1 = Nothing
geoIntent = Nothing
XPos = Nothing
YPos = Nothing
tempObject = Nothing
' Exit after we place a symbol
GoTo nextFace
Catch E As Exception
Logger.Info(E.ToString())
End Try
Next
Next
nextFace :
Logger.Info("NEXT FACE")
End Sub
Public Sub AddLegendSymbolsToDrawing()
' This section takes care of adding the treatments legend to the upper left hand corner of the drawing
' Order the tags by their tag number
Dim byTag As List(Of ColourTreatment) = assignedColourTreatments.OrderBy(Function(cT1) cT1.TagNumber).ToList
Dim sheetBorder As Border = currentSheet.Border
Dim sheetTopLeftX As Double = sheetBorder.RangeBox.MinPoint.X + 1
Dim sheetTopLeftY As Double = sheetBorder.RangeBox.MaxPoint.Y - 1
Dim sheetTopLeft As Point2d = transGeometry.CreatePoint2d(sheetTopLeftX, sheetTopLeftY)
For Each tag As ColourTreatment In byTag
' The second string is the Treatment and RAL name combined
Dim promptStringsTwo = New String() {tag.TagNumber, tag.Treatment & " - " & tag.RALColourName }
Logger.Info(tag.TagNumber & ", " & tag.Treatment & " - " & tag.RALColourName)
sheetTopLeft.Y = sheetTopLeft.Y - 1.5
' Add the symbol to the drwaing to create the legend
Dim legendSymbol As SketchedSymbol = currentSheet.SketchedSymbols.Add(treatmentSymbolDef, sheetTopLeft, 0, 1, promptStringsTwo)
legendSymbol.Static = True
Next
End Sub
End Class ']j
The leader placement now looks like below. Please note that sometimes you will get multiple leaders that appear to be going to one face, like on the far left. The top left leader (1) is actually trying to reference the face that isn't shown in the view. This is because there is no easy way (that I know of) to tell if the face connected to the edge is shown in the view. So the end user will have to clean-up a little.
If this is an acceptable solution please mark it so, that way others can easily find it.
Cheers,
James
