Place component occurrences on separate layers

<?xml encoding=”UTF-8″>By Adam Nagy

If you want to place the component occurrences of an assembly inside a drawing on separate layers, then you could do it like this. There is a blog post on how to create new layers: http://adndevblog.typepad.com/manufacturing/2012/05/changing-an-objects-layer-in-a-drawingdocument.html

This is what we start with:

This is the code:

Function GetRandomColor() As color
Dim t As TransientObjects
Set t = ThisApplication.TransientObjects
Dim colors(2) As Single
Dim i As Integer
For i = 0 To 2
Call Randomize
' Rnd() returns between 0 and 1
colors(i) = Rnd() * 255
Next
Set GetRandomColor = t.CreateColor( _
colors(0), colors(1), colors(2))
End Function
Sub PutOccurrencesOnSeparateLayers()
Dim d As DrawingDocument
Set d = ThisApplication.ActiveDocument
Dim dv As DrawingView
Set dv = d.ActiveSheet.DrawingViews(1)
Dim dd As DocumentDescriptor
Set dd = dv.ReferencedDocumentDescriptor
Dim a As AssemblyDocument
Set a = dd.ReferencedDocument
Dim cs As ComponentOccurrences
Set cs = a.ComponentDefinition.Occurrences
' Base Layer that we'll copy
Dim bl As Layer
Set bl = d.StylesManager.Layers(1)
Dim co As ComponentOccurrence
For Each co In cs.AllLeafOccurrences
If Not co.Suppressed Then
' This might throw an error if none
' exists, so we use error handling
Dim dce As DrawingCurvesEnumerator
On Error Resume Next
Set dce = dv.DrawingCurves(co)
On Error GoTo 0
If Not dce Is Nothing Then
' Create new layer
Dim l As Layer
Set l = bl.Copy(co.name)
l.color = GetRandomColor()
l.LineType = kContinuousLineType
Dim dc As DrawingCurve
For Each dc In dce
Dim dcs As DrawingCurveSegment
For Each dcs In dc.segments
dcs.Layer = l
Next
Next
End If
End If
Next
End Sub

This is the result: