Hey probably just something silly but I'm still getting an error.
It says "Object variable or With block variable not set."
I'll paste my full code below I'm guessing I don't have the features defined correctly. Thanks!
Sub Main
Dim oDoc As DrawingDocument
Dim oSheet As Sheet
Dim oViews As DrawingViews
Dim oView As DrawingView
' Get the active drawing document.
oDoc = ThisApplication.ActiveDocument
'call the sub to create layer
Call CreateLayer
'get current sheet so it can
'be made active again later
Dim oCurrentSheet As Sheet
oCurrentSheet = oDoc.ActiveSheet
' Iterate through the sheets
For Each oSheet In oDoc.Sheets
' activate the sheet
oSheet.Activate
' Iterate through the views on the sheet
For Each oView In oSheet.DrawingViews
Dim docDesc As DocumentDescriptor
docDesc = oView.ReferencedDocumentDescriptor
' Verify that the drawing view is of part
If docDesc.ReferencedDocumentType <> kPartDocumentObject Then
Continue For
End If
' Get the component definition
Dim oCompDef As PartComponentDefinition
oCompDef = docDesc.ReferencedDocument.ComponentDefinition
' Process the view, wrapping it in a transaction so the
' each view can be undone with a single undo operation.
Dim trans As Transaction
trans = ThisApplication.TransactionManager.StartTransaction( _
oDoc, "Change drawing view color")
' Call the sub to change colors
Call ProcessColor(oView, oCompDef)
trans.End
Next
'update the sheet
oSheet.Update
Next
'return to original sheet
oCurrentSheet.Activate
End Sub
Private Sub ProcessColor(drawView As DrawingView, _
oCompDef As ComponentDefinition)
' Iterate through features
Dim occ As ComponentOccurrence
For Each oFeature In oCompDef.Features
If TypeOf oFeature Is HoleFeature Then
If oFeature.HoleDiameter.Value = 0.65278 Then
' Get all of the curves associated with the feature
On Error Resume Next
Dim drawcurves As DrawingCurvesEnumerator
'drawcurves = drawView.DrawingCurves(occ)
drawcurves = drawView.DrawingCurves(oFeature)
If Err.Number = 0 Then
On Error GoTo 0
' Create an empty collection.
Dim objColl As ObjectCollection
objColl = ThisApplication.TransientObjects.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
Dim colorLayer As Layer
colorLayer = ThisDoc.Document .StylesManager.Layers.Item("Holes")
' Change the layer of all of the segments.
Call drawView.Parent.ChangeLayer(objColl, colorLayer)
End If
On Error GoTo 0
End If 'ends if hole feature
End If
Next 'feature
End Sub
Sub CreateLayer
Dim oDoc As DrawingDocument
oDoc = ThisDoc.Document
' Verify that a layer exists for this color.
Dim layers As LayersEnumerator
layers = oDoc.StylesManager.Layers
On Error Resume Next
Dim colorLayer As Layer
colorLayer = layers.Item("Holes")
If Err.Number <> 0 Then
On Error GoTo 0
'set to magenta
Dim newColor As color
newColor = ThisApplication.TransientObjects.CreateColor(255, 0, 255)
' Copy an arbitrary layer giving it the name
' of the render style.
colorLayer = layers.Item(1).Copy("Holes")
' 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
End Sub
