Drawing views with part color 'macro' with error message
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
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