Place component occurrences on separate layers

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: