edit color of drawing layers with materials from parts

[Anonymous]

Hello 

I just found this code for color of layer editing with material properties from part but it doesent work when i run the rule.

Sub Main

    drawDoc = TryCast(ThisDoc.Document, DrawingDocument)

    If (drawDoc Is Nothing) Then

       MessageBox.Show("This rule can only be run in a drawing,", "iLogic")

       Return

    End If

    ChangeLayerOfOccurrenceCurves()

End Sub

Private drawDoc As DrawingDocument

Public Sub ChangeLayerOfOccurrenceCurves()

    ' Process the occurrences, wrapping it in a transaction so the

    ' entire process can be undone with a single undo operation.

    Dim trans As Transaction

    trans = ThisApplication.TransactionManager.StartTransaction(drawDoc, "Drawing Layers by Materials")

    Try

        For Each dSheet As Sheet In drawDoc.Sheets

            For Each drawView As DrawingView In dSheet.DrawingViews

                ' Call the recursive function that does all the work.

                Dim docDesc As DocumentDescriptor

                docDesc = drawView.ReferencedDocumentDescriptor

                If (docDesc Is Nothing) Then Continue For

                If (docDesc.ReferencedDocumentType <> DocumentTypeEnum.kAssemblyDocumentObject) Then Continue For

                Dim asmDef As AssemblyComponentDefinition

                asmDef = docDesc.ReferencedDocument.ComponentDefinition

                Call ProcessOccurrences(drawView, asmDef.Occurrences)

            Next

        Next

    Catch ex As Exception

        trans.Abort()

        Throw ex

    End Try

    trans.End()

End Sub

Private Sub ProcessOccurrences(ByVal drawView As DrawingView, _

   ByVal Occurrences As ComponentOccurrences)

    ' Iterate through the current collection of occurrences.

    Dim occ As ComponentOccurrence

    For Each occ In Occurrences

        If (occ.Suppressed) Then Continue For

        If (occ.Definition Is Nothing) Then Continue For

        ' Check to see if this occurrence is a part or assembly.

        If occ.DefinitionDocumentType = DocumentTypeEnum.kPartDocumentObject Then

            ' ** It's a part so get the material

            Dim subDoc As Document = occ.Definition.Document

            If (subDoc Is Nothing) Then Continue For

            Dim partDoc As PartDocument = subDoc

            Dim materialName = partDoc.ComponentDefinition.Material.Name

            ' Get the TransientsObjects object to use later.

            Dim transObjs As TransientObjects

            transObjs = ThisApplication.TransientObjects

            ' Verify that a layer exists for this material.

            Dim layers As LayersEnumerator

            layers = drawDoc.StylesManager.Layers

            On Error Resume Next

            Dim newLayer As Layer

            newLayer = layers.Item(materialName)

            If Err.Number <> 0 Then

                On Error Goto 0

                ' Copy an arbitrary layer giving it the name

                ' of the material.

                newLayer = layers.Item(1).Copy(materialName)

                ' Set the attributes of the layer to use the color,

                ' have a solid line type, and a specific width.

                '                    newLayer.Color = newColor

                newLayer.LineType = LineTypeEnum.kContinuousLineType

                'newLayer.LineWeight = 0.02

            End If

            On Error Goto 0

            ' Get all of the curves associated with this occurrence.

            On Error Resume Next

            Dim drawcurves As DrawingCurvesEnumerator

            drawcurves = drawView.DrawingCurves(occ)

            If Err.Number = 0 Then

                On Error Goto 0

                ' Create an empty collection.

                Dim objColl As ObjectCollection

                objColl = transObjs.CreateObjectCollection()

                ' Add the curve segments to the collection.

                Dim drawCurve As DrawingCurve

                For Each drawCurve In drawcurves

                    Dim segment As DrawingCurveSegment

                    For Each segment In drawCurve.Segments

                        objColl.Add(segment)

                    Next

                Next

                ' Change the layer of all of the segments.

                Call drawView.Parent.ChangeLayer(objColl, newLayer)

            End If

            On Error Goto 0

        Else

            ' It's an assembly so process its contents.

            Call ProcessOccurrences(drawView, occ.SubOccurrences)

        End If

    Next

End Sub

[salariua · Accepted solution]

Bear in mind that these solutions tend to slow down inventor to a halt especially for large assemblies.

Here's some more info