I think I am using the same code as referenced above. I am not very good yet at coding so I wondered if anyone could help modify the code.
The issue I have is that all the lines will change to match the color of the model but the lines that it put on the "visible narrow" layer don't match.
It leaves those lines as white. For example a spline will show as white instead of matching the color of the model.
Sub Main
' Get the active drawing document.
Dim oDoc As DrawingDocument
oDoc = ThisApplication.ActiveDocument
Dim oSheets As Sheets
oSheets = oDoc.Sheets
Dim oSheet As Sheet
'get current sheet so it can
'be made active again later
Dim oCurrentSheet As Sheet
oCurrentSheet = oDoc.ActiveSheet
Dim oViews As DrawingViews
Dim oView As DrawingView
' Iterate through the sheets
For Each oSheet In oSheets
' activate the sheet
oSheet.Activate
'get the collection of view on the sheet
oViews = oSheet.DrawingViews
' Iterate through the views on the sheet
For Each oView In oViews
Dim docDesc As DocumentDescriptor
docDesc = oView.ReferencedDocumentDescriptor
' Verify that the drawing view is of an assembly.
If docDesc.ReferencedDocumentType <> kAssemblyDocumentObject Then
Continue For
End If
' Get the component definition for the assembly.
Dim asmDef As AssemblyComponentDefinition
asmDef = docDesc.ReferencedDocument.ComponentDefinition
' Process the view, wrapping it in a transaction so the
' each view can be undone with a single undo operation.
Dim trans As Transaction
trans = ThisApplication.TransactionManager.StartTransaction( _
oDoc, "Change drawing view color")
' Call the recursive function that does all the work.
Call ProcessAssemblyColor(oView, asmDef.Occurrences)
trans.End
Next
'update the sheet
oSheet.Update
Next
'return to original sheet
oCurrentSheet.Activate
End Sub
Private Sub ProcessAssemblyColor(drawView As DrawingView, _
Occurrences As ComponentOccurrences)
' Iterate through the current collection of occurrences.
Dim occ As ComponentOccurrence
For Each occ In Occurrences
' Check to see if this occurrence is a part or assembly.
If occ.DefinitionDocumentType = kPartDocumentObject Then
' ** It's a part so process the color.
' Get the render style of the occurrence.
Dim color As RenderStyle
Dim sourceType As StyleSourceTypeEnum
color = occ.GetRenderStyle(sourceType)
' Get the TransientsObjects object to use later.
Dim transObjs As TransientObjects
transObjs = ThisApplication.TransientObjects
' Verify that a layer exists for this color.
Dim layers As LayersEnumerator
layers = drawView.Parent.Parent.StylesManager.layers
Dim oDoc As DrawingDocument
oDoc = drawView.Parent.Parent
On Error Resume Next
Dim colorLayer As Layer
colorLayer = layers.Item(color.Name)
If Err.Number <> 0 Then
On Error GoTo 0
' Get the diffuse color for the render style.
Dim red As Byte
Dim green As Byte
Dim blue As Byte
' Create a color object that is the diffuse color.
Call color.GetDiffuseColor(red, green, blue)
Dim newColor As color
newColor = transObjs.CreateColor(red, green, blue)
' Copy an arbitrary layer giving it the name
' of the render style.
colorLayer = layers.Item(1).Copy(color.Name)
' the attributes of the layer to use the color,
' have a solid line type, and a specific width.
colorLayer.Color = newColor
colorLayer.LineType = kContinuousLineType
colorLayer.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, colorLayer)
End If
On Error GoTo 0
Else
' It's an assembly so process its contents.
Call ProcessAssemblyColor(drawView, occ.SubOccurrences)
End If
Next
End Sub
