iLogic to change the layer based on Appearance

[Anonymous]

I would like to change the layers in a drawing based on a part's Appearance.  I have found iLogic code to do it based on the part's material but then the physical properties of the part would not be correct. On the same layer some parts are plastic some steel and some aluminum.  My end goal is to comply with national CAD standards and the layering convention established by the Army Corps.  Ideally the code would be able to also tell the difference between line types and assign different layers to them (E-POWR-PANL and E-POWR-PANL-HIDDEN)

The code I am using is below, it works but only gets me part of the way.

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