Drawing views with part color 'macro' with error message

Drawing views with part color 'macro' with error message

beau-tech
Advocate Advocate
375 Views
0 Replies
Message 1 of 1

Drawing views with part color 'macro' with error message

beau-tech
Advocate
Advocate

I posted this on the regular forum and thought maybe someone here could help. I am rookie at macros in IV and this one is generating an error (see attachment). I need to finish a project and could use this asap. Thanks in advance.

 

Cut & pasted from the regular forum:

 

There is a nice sample from Brian Ekins

on

http://modthemachine.typepad.com/my_weblog/2010/10/index.html

 

***************************

Public Sub ChangeLayerOfOccurrenceCurves()
   ' Get the active drawing document.
   Dim drawDoc As DrawingDocument
   Set drawDoc = ThisApplication.ActiveDocument

   ' Have the user select a drawing view.
   Dim drawView As DrawingView
   Set drawView = ThisApplication.CommandManager.Pick( _
                  kDrawingViewFilter, "Select a drawing view.")

   Dim docDesc As DocumentDescriptor
   Set docDesc = drawView.ReferencedDocumentDescriptor

   ' Verify that the selected drawing view is of an assembly.
   If docDesc.ReferencedDocumentType <> kAssemblyDocumentObject Then
      MsgBox "The selected view must be of an assembly."
      Exit Sub
   End If

   ' Get the component definition for the assembly.
   Dim asmDef As AssemblyComponentDefinition
   Set asmDef = docDesc.ReferencedDocument.ComponentDefinition

   ' Process the occurrences, wrapping it in a transaction so the
   ' entire process can be undone with a single undo operation.
   Dim trans As Transaction
   Set trans = ThisApplication.TransactionManager.StartTransaction( _
drawDoc, "Change drawing view color")

   ' Call the recursive function that does all the work.
   Call ProcessAssemblyColor(drawView, asmDef.Occurrences)
   trans.End
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
         Set color = occ.GetRenderStyle(sourceType)

         ' Get the TransientsObjects object to use later.
         Dim transObjs As TransientObjects
         Set transObjs = ThisApplication.TransientObjects

         ' Verify that a layer exists for this color.
         Dim layers As LayersEnumerator
         Set layers = drawView.Parent.Parent.StylesManager.layers

         Dim drawDoc As DrawingDocument
         Set drawDoc = drawView.Parent.Parent

         On Error Resume Next
         Dim colorLayer As Layer
         Set 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
            Set newColor = transObjs.CreateColor(red, green, blue)

            ' Copy an arbitrary layer giving it the name
            ' of the render style.
            Set colorLayer = layers.Item(1).Copy(color.Name)

            ' Set 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
         Set drawcurves = drawView.DrawingCurves(occ)
         If Err.Number = 0 Then
            On Error GoTo 0

            ' Create an empty collection.
            Dim objColl As ObjectCollection
            Set 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

0 Likes
376 Views
0 Replies
Replies (0)