Is there a way to have the lines in drawing views in the part colors instead of black (like MDT used to do)? Not rendered, 2d lines.
Thanks.
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
Frank,
I had seen this macro before, but forgot where I had seen it before I ever had a chance to try it out. When I saw it posted here, I thought I'd give it a shot.
When I try to run it, I get an error message:
"Run-time error 438: Object doesn't support this property or method."
Set drawView = ThisApplication.CommandManager.Pick( _ kDrawingViewFilter, "Select a drawing view.")
Any idea what the problem is? Is there something we are supposed to modify about that line before it will work, or should it function exactly as you posted it?
Never mind - after reading the article again, it seems to use some code not available prior to Inventor 2011. It doesn't seem to list the error-giving portion as being so, but maybe it is. At any rate, even if I fixed it, it looks like I wouldn't be able to run the code anyway.
I tried running the macro and got this message (see attached file). It shows the error message box and the highlighted line item shown when using the 'debug' tool.
I am super green with this stuff and this is my first macro. I have made quite a few in Autocad & MDT but none in IV.
Inventor 2012, sp1
Thanks.
Anyone help with the error? I went to the site that this came from and didn't see a way to contact the writer. I really could use this macro to finish a job.
Thank you.