Need help to change layer of sketch entities using DrawingCurve Method

[They_Call_Me_Jake]

I have been researching this a lot and I'm getting closer and closer and I think I'm down to the last little bit but I need some help as I am just learning how to program so I am having trouble putting this together. I have a drawing with a view and in that view is an assembly with parts and in those parts are sketches. What I am trying to do is set a layer to specific sketches as geometry is added to them. I have the code pretty much worked out in how to select the view I want all the way down to actually selecting the sketch I want to assign the layer to. Where I am getting stuck is how to piece together the code that grabs all the entities of the sketch using the DrawingCurve Method. Everything that I have seen as an example expects that the entities are manually selected but I am using a For loop to cycle thru and select the sketch I want based on name and then I set a Sketch Proxy so I can make changes (at least that is what I do when I want to hide specific sketches) Here is the code I have so far. If someone out there would be willing to help me piece this together so that it works I would be ever so grateful. Right now I get an error that "Object reference not set to an instance of an object."

Dim oDoc As DrawingDocument
	oDoc = ThisApplication.ActiveDocument

Dim oActiveSheet As Sheet
	oActiveSheet = oDoc.ActiveSheet

Dim oDrawingView As DrawingView
	oDrawingView = oActiveSheet.DrawingViews(1)
    
Dim oRefDoc As AssemblyDocument
	oRefDoc = oDrawingView.ReferencedDocumentDescriptor.ReferencedDocument
	
Dim oAssDef As AssemblyComponentDefinition
	oAssDef = oRefDoc.ComponentDefinition
    
Dim oOcc As ComponentOccurrence
	oOcc = oAssDef.Occurrences(1)
    
Dim oPart As PartDocument
	oPart = oOcc.Definition.Document

Dim oDef As PartComponentDefinition
	oDef = oPart.ComponentDefinition
	
Dim oSketch As PlanarSketch
	For Each oSketch In oDef.Sketches
		Dim oSketchProxy As PlanarSketchProxy
		oOcc.CreateGeometryProxy(oSketch, oSketchProxy)
		If oSketch.Name = "SK MTG Holes" Then
			Dim oDrawingCurveSegments As DrawingCurveSegments
			Dim oDrawingCurve As DrawingCurve
			Dim oDrawingCurveSegment As DrawingCurveSegment
			oDrawingCurve = oDrawingCurveSegment.Parent
				For Each oDrawingCurveSegment In oDrawingCurveSegments
					oDrawingCurveSegment.Layer = oDoc.StylesManager.Layers.Item("COUNTERSINK1.0POLY_8(913)")
				Next
		End If
	Next

[Owner2229 · Accepted solution]

Hey, maybe this will do:

Dim oDoc As DrawingDocument = ThisApplication.ActiveDocument
Dim oActiveSheet As Sheet = oDoc.ActiveSheet
Dim oView As DrawingView = oActiveSheet.DrawingViews(1)
Dim oRefDoc As AssemblyDocument = oView.ReferencedDocumentDescriptor.ReferencedDocument
Dim oAssDef As AssemblyComponentDefinition = oRefDoc.ComponentDefinition
Dim oOcc As ComponentOccurrence = oAssDef.Occurrences(1)
Dim oPart As PartDocument = oOcc.Definition.Document
Dim oDef As PartComponentDefinition = oPart.ComponentDefinition

Dim oSketch As PlanarSketch = oDef.Sketches("SK MTG Holes")
If oSketch Is Nothing Then Exit Sub
Dim oProxy As PlanarSketchProxy
oOcc.CreateGeometryProxy(oSketch, oProxy)
Dim oTO As TransientObjects = ThisApplication.TransientObjects
Dim oColl As ObjectCollection = oTO.CreateObjectCollection()

Dim oCurves As DrawingCurvesEnumerator = oView.DrawingCurves(oProxy)
For Each oCurve As DrawingCurve In oCurves
    For Each oSegment As DrawingCurveSegment In oCurve.Segments
        oColl.Add(oSegment)
    Next
Next

Dim oLayer As Layer = oDoc.StylesManager.Layers.Item("COUNTERSINK1.0POLY_8(913)")
Call oView.Parent.ChangeLayer(oColl, oLayer)

[They_Call_Me_Jake]

Mike, Thank you, Thank you, Thank you. This worked perfectly. I have been beating my head against a wall trying to understand how to put this together with no success and not being a programmer doesn't help. You have made my Monday morning a good Monday and a good start to the week. Thanks again. 

[They_Call_Me_Jake]

Mike I have one other question. Say I had a few different sketches in the same part and each sketch was assigned to a different layer how would I be able to use an array to change out the 2 values I tried the below code but I get the error "Explicit initialization is not permitted for arrays declared with explicit bounds". 
 

	Dim oDoc As DrawingDocument = ThisApplication.ActiveDocument
	Dim oActiveSheet As Sheet = oDoc.ActiveSheet
	Dim oView As DrawingView = oActiveSheet.DrawingViews(1)
	Dim oRefDoc As AssemblyDocument = oView.ReferencedDocumentDescriptor.ReferencedDocument
	Dim oAssDef As AssemblyComponentDefinition = oRefDoc.ComponentDefinition
	Dim oOcc As ComponentOccurrence = oAssDef.Occurrences(1)
	Dim oPart As PartDocument = oOcc.Definition.Document
	Dim oDef As PartComponentDefinition = oPart.ComponentDefinition
	
	Dim oSketchName(2) As String = {"SK MTG HOles", "SK Box MTG Holes", "SK Seal Mill"}
	Dim oLayerName(2) As String = {"COUNTERSINK1.0POLY_8(913)","DRILL1.0POLY.1562BIT(839)", "MILL.125BIT.8125DEEP(466)"}
	Dim intCount As Integer
	For intCount = 0 To 2
		Dim oSketch As PlanarSketch = oDef.Sketches(oSketchName)
		If oSketch Is Nothing Then Exit Sub
			Dim oProxy As PlanarSketchProxy
			oOcc.CreateGeometryProxy(oSketch, oProxy)
			Dim oTO As TransientObjects = ThisApplication.TransientObjects
			Dim oColl As ObjectCollection = oTO.CreateObjectCollection()
			
			Dim oCurves As DrawingCurvesEnumerator = oView.DrawingCurves(oProxy)
			For Each oCurve As DrawingCurve In oCurves
				For Each oSegment As DrawingCurveSegment In oCurve.Segments
					oColl.Add(oSegment)
				Next
			Next
		
		Dim oLayer As Layer = oDoc.StylesManager.Layers.Item(oLayerName)
		Call oView.Parent.ChangeLayer(oColl, oLayer)
	Next

[Owner2229 · Accepted solution]

Hey, how about this? Red is what I've changed / added.

	Dim oDoc As DrawingDocument = ThisApplication.ActiveDocument
	Dim oActiveSheet As Sheet = oDoc.ActiveSheet
	Dim oView As DrawingView = oActiveSheet.DrawingViews(1)
	Dim oRefDoc As AssemblyDocument = oView.ReferencedDocumentDescriptor.ReferencedDocument
	Dim oAssDef As AssemblyComponentDefinition = oRefDoc.ComponentDefinition
	Dim oOcc As ComponentOccurrence = oAssDef.Occurrences(1)
	Dim oPart As PartDocument = oOcc.Definition.Document
	Dim oDef As PartComponentDefinition = oPart.ComponentDefinition
	
	Dim oSketchName() As String = {"SK MTG HOles", "SK Box MTG Holes", "SK Seal Mill"}
	Dim oLayerName() As String = {"COUNTERSINK1.0POLY_8(913)", "DRILL1.0POLY.1562BIT(839)", "MILL.125BIT.8125DEEP(466)"}
	If oSketchName.Length <> oLayerName.Length Then
		MsgBox("The arrays must have the same length.")
		Exit Sub
	End If
	For i As Integer = 0 To (oSketchName.Length - 1)
		Dim oSketch As PlanarSketch = oDef.Sketches(oSketchName(i))
		If oSketch Is Nothing Then Continue For
		Dim oProxy As PlanarSketchProxy
		oOcc.CreateGeometryProxy(oSketch, oProxy)
		Dim oTO As TransientObjects = ThisApplication.TransientObjects
		Dim oColl As ObjectCollection = oTO.CreateObjectCollection()
		
		Dim oCurves As DrawingCurvesEnumerator = oView.DrawingCurves(oProxy)
		For Each oCurve As DrawingCurve In oCurves
			For Each oSegment As DrawingCurveSegment In oCurve.Segments
				oColl.Add(oSegment)
			Next
		Next
		
		Dim oLayer As Layer = oDoc.StylesManager.Layers.Item(oLayerName(i))
		If oLayer Is Nothing Then Continue For
		Call oView.Parent.ChangeLayer(oColl, oLayer)
	Next

 Also, here's another option you could use:

	Dim oDoc As DrawingDocument = ThisApplication.ActiveDocument
	Dim oActiveSheet As Sheet = oDoc.ActiveSheet
	Dim oView As DrawingView = oActiveSheet.DrawingViews(1)
	Dim oRefDoc As AssemblyDocument = oView.ReferencedDocumentDescriptor.ReferencedDocument
	Dim oAssDef As AssemblyComponentDefinition = oRefDoc.ComponentDefinition
	Dim oOcc As ComponentOccurrence = oAssDef.Occurrences(1)
	Dim oPart As PartDocument = oOcc.Definition.Document
	Dim oDef As PartComponentDefinition = oPart.ComponentDefinition
	
	For Each oSketch As PlanarSketch In oDef.Sketches
		Dim oLayerName As String = vbNullString
		Select Case oSketch.Name
		Case "SK MTG HOles":		oLayerName = "COUNTERSINK1.0POLY_8(913)"
		Case "SK Box MTG Holes":	oLayerName = "DRILL1.0POLY.1562BIT(839)"
		Case "SK Seal Mill":		oLayerName = "MILL.125BIT.8125DEEP(466)"
		Case Else:			Continue For
		End Select
		Dim oProxy As PlanarSketchProxy
		oOcc.CreateGeometryProxy(oSketch, oProxy)
		Dim oTO As TransientObjects = ThisApplication.TransientObjects
		Dim oColl As ObjectCollection = oTO.CreateObjectCollection()
		
		Dim oCurves As DrawingCurvesEnumerator = oView.DrawingCurves(oProxy)
		For Each oCurve As DrawingCurve In oCurves
			For Each oSegment As DrawingCurveSegment In oCurve.Segments
				oColl.Add(oSegment)
			Next
		Next
		
		Dim oLayer As Layer = oDoc.StylesManager.Layers.Item(oLayerName)
		If oLayer Is Nothing Then Continue For
		Call oView.Parent.ChangeLayer(oColl, oLayer)
	Next

[They_Call_Me_Jake]

Thanks again Mike. You are awesome. The one with the variables outside the for loop is the one that I am going with for now. My next challenge will be to have the 2 arrays populated from 2 columns of an Excel spreadsheet...1 column for the sketch names and another column for the layer names. We have over 400 layers that we use and I want to make a master spreadsheet with all the layer names with a corresponding "Sketch Name" so that we can use it on any drawing we create so long as we use the proper naming convention that we set up.

[They_Call_Me_Jake]

So This is as far as I get. I'm able to pass the information in the Excel Spreadsheet into an array (at least that's what I think I'm doing.) But now I don't know how to have my for loop that scans thru all my sketch check to see if a sketch name matches one in the array and then do it's thing of changing the layer of the segments. Also not sure how to make sure that the right layer goes to the right name (if the sketch name matches a name in the array that is say the 37th name it needs to change that layer to the layer that is 37th one in the array of layer names). Here's my code so far.

	Dim oDoc As DrawingDocument = ThisApplication.ActiveDocument
	Dim oActiveSheet As Sheet = oDoc.ActiveSheet
	Dim oView As DrawingView = oActiveSheet.DrawingViews(1)
	Dim oRefDoc As AssemblyDocument = oView.ReferencedDocumentDescriptor.ReferencedDocument
	Dim oAssDef As AssemblyComponentDefinition = oRefDoc.ComponentDefinition
	Dim oOcc As ComponentOccurrence = oAssDef.Occurrences(1)
	Dim oPart As PartDocument = oOcc.Definition.Document
	Dim oDef As PartComponentDefinition = oPart.ComponentDefinition
	
	GoExcel.Open("Sketch Layer Names.xlsx")
	For rowNumber = 2 To 10000
		If (GoExcel.CellValue("A" & rowNumber) = "") Then
		lastUsedRow = rowNumber - 1
		Exit For
		End If
	Next
	
	Dim oSketchNameArray As New ArrayList
	Dim oLayerNameArray As New ArrayList
	i = 2
	
	Do Until i = lastUsedRow +1 
	oSketchNameArray.add(GoExcel.CellValue("A" & i)) 
	oLayerNameArray.add(GoExcel.CellValue("B" & i))
	i = i + 1
	Loop
	
?? This is where I don't know how to pass the array into my For Loop to check against???
	
	For i As Integer = 0 To (lastUsedRow)
		Dim oSketch As PlanarSketch = oDef.Sketches(oSketchNameArray.Item(i))
		If oSketch Is Nothing Then Continue For
			Dim oProxy As PlanarSketchProxy
			oOcc.CreateGeometryProxy(oSketch, oProxy)
			Dim oTO As TransientObjects = ThisApplication.TransientObjects
			Dim oColl As ObjectCollection = oTO.CreateObjectCollection()
			
			Dim oCurves As DrawingCurvesEnumerator = oView.DrawingCurves(oProxy)
			For Each oCurve As DrawingCurve In oCurves
				For Each oSegment As DrawingCurveSegment In oCurve.Segments
					oColl.Add(oSegment)
				Next
			Next
		
		Dim oLayer As Layer = oDoc.StylesManager.Layers.Item(oLayerNameArray(i))
		If oLayer Is Nothing Then Continue For
		Call oView.Parent.ChangeLayer(oColl, oLayer)
	Next

[Owner2229]

Try it like this:

Sub Main()
	Dim oDoc As DrawingDocument = ThisApplication.ActiveDocument
	Dim oActiveSheet As Sheet = oDoc.ActiveSheet
	Dim oView As DrawingView = oActiveSheet.DrawingViews(1)
	Dim oRefDoc As AssemblyDocument = oView.ReferencedDocumentDescriptor.ReferencedDocument
	Dim oAssDef As AssemblyComponentDefinition = oRefDoc.ComponentDefinition
	Dim oOcc As ComponentOccurrence = oAssDef.Occurrences(1)
	Dim oPart As PartDocument = oOcc.Definition.Document
	Dim oDef As PartComponentDefinition = oPart.ComponentDefinition
	
	AddDT()

	For Each oSketch As PlanarSketch In oDef.Sketches
		Dim oLayerName As String = GetLayerName(oSketch.Name)
		If oLayerName = vbNullString Then Continue For
		Dim oProxy As PlanarSketchProxy
		oOcc.CreateGeometryProxy(oSketch, oProxy)
		Dim oTO As TransientObjects = ThisApplication.TransientObjects
		Dim oColl As ObjectCollection = oTO.CreateObjectCollection()
			
		Dim oCurves As DrawingCurvesEnumerator = oView.DrawingCurves(oProxy)
		For Each oCurve As DrawingCurve In oCurves
			For Each oSegment As DrawingCurveSegment In oCurve.Segments
				oColl.Add(oSegment)
			Next
		Next
		
		Dim oLayer As Layer = oDoc.StylesManager.Layers.Item(oLayerName)
		If oLayer Is Nothing Then Continue For
		Call oView.Parent.ChangeLayer(oColl, oLayer)
	Next
End Sub

Private DT As System.Data.DataTable

Sub AddDT()
	DT = New System.Data.DataTable
	DT.Columns.Add("Sketch", GetType(String))
	DT.Columns.Add("Layer", GetType(String))
	GoExcel.Open("Sketch Layer Names.xlsx")
	For rowNumber = 2 To 10000
		Dim S As String = GoExcel.CellValue("A" & rowNumber)
		Dim L As String = GoExcel.CellValue("B" & rowNumber)
		If S = vbNullString Then Exit For
		DT.Rows.Add(S, L)
	Next
End Sub

Function GetLayerName(oSketchName As String) As String
	If DT Is Nothing Then Return vbNullString
	If DT.Rows.Count = 0 Then Return vbNullString
	Dim oRow() As DataRow = DT.Select("Sketch = '" & oSketchName & "'")
	If oRow.Length = 0 Then Return vbNullString
	Return oRow(0)("Layer").ToString
End Function

[They_Call_Me_Jake]

Thanks again Mike. I tried the code and I am getting an error that the DataTable isn't defined. I am assuming that this is referring to an Excel DataTable. If this is correct then I am a little lost. I have tried to create the DataTable in excel but I'm not getting the results that I want. When it asks me to select an input cell I'm not sure which one I should use. I have tried various combinations and non result in what I'm looking for. It might have to do with how I explained how the Excel Spreadsheet is set up. I will have 2 columns, one will have the Sketch names in it, this is column A and Column B will have the Layer names in it. The sketch names will be different from the Layer names.  

[Owner2229 · Accepted solution]

It looks like it needs the imports after all. Try it now:

The issue was in missing references to the libraries needed for the object type I used (System.Data.Datatable and System.Data.DataRow)

AddReference "System.XML.dll"
AddReference "System.Data.dll"
Sub Main()
	Dim oDoc As Document = ThisApplication.ActiveDocument
	If oDoc.DocumentType <> DocumentTypeEnum.kDrawingDocumentObject Then Exit Sub
	Dim oActiveSheet As Sheet = oDoc.ActiveSheet
	Dim oView As DrawingView = oActiveSheet.DrawingViews(1)
	Dim oRefDoc As AssemblyDocument = oView.ReferencedDocumentDescriptor.ReferencedDocument
	Dim oAssDef As AssemblyComponentDefinition = oRefDoc.ComponentDefinition
	Dim oOcc As ComponentOccurrence = oAssDef.Occurrences(1)
	Dim oPart As PartDocument = oOcc.Definition.Document
	Dim oDef As PartComponentDefinition = oPart.ComponentDefinition
	
	AddDT()

	For Each oSketch As PlanarSketch In oDef.Sketches
		Dim oLayerName As String = GetLayerName(oSketch.Name)
		If oLayerName = vbNullString Then Continue For
		Dim oProxy As PlanarSketchProxy
		oOcc.CreateGeometryProxy(oSketch, oProxy)
		Dim oTO As TransientObjects = ThisApplication.TransientObjects
		Dim oColl As ObjectCollection = oTO.CreateObjectCollection()
			
		Dim oCurves As DrawingCurvesEnumerator = oView.DrawingCurves(oProxy)
		For Each oCurve As DrawingCurve In oCurves
			For Each oSegment As DrawingCurveSegment In oCurve.Segments
				oColl.Add(oSegment)
			Next
		Next
		
		Dim oLayer As Layer = oDoc.StylesManager.Layers.Item(oLayerName)
		If oLayer Is Nothing Then Continue For
		Call oView.Parent.ChangeLayer(oColl, oLayer)
	Next
End Sub

Private DT As System.Data.DataTable

Sub AddDT()
	DT = New System.Data.DataTable
	DT.Columns.Add("Sketch", GetType(String))
	DT.Columns.Add("Layer", GetType(String))
	GoExcel.Open("Sketch Layer Names.xlsx")
	For rowNumber = 2 To 10000
		Dim S As String = GoExcel.CellValue("A" & rowNumber)
		Dim L As String = GoExcel.CellValue("B" & rowNumber)
		If S = vbNullString Then Exit For
		DT.Rows.Add(S, L)
	Next
End Sub

Function GetLayerName(oSketchName As String) As String
	If DT Is Nothing Then Return vbNullString
	If DT.Rows.Count = 0 Then Return vbNullString
	Dim oRow() As System.Data.DataRow = DT.Select("Sketch = '" & oSketchName & "'")
	If oRow.Length = 0 Then Return vbNullString
	Return oRow(0)("Layer").ToString
End Function

[They_Call_Me_Jake]

Mike, it worked like a charm. You are awesome. Thank you so much. This is going to make things so much easier and less room for error now. Thanks again.

[They_Call_Me_Jake]

Mike, I wanted to thank you again for your help. That said I wanted to adjust the code a little to fine tune it for what we are trying to accomplish and I got it working except for one thing I can't figure out. I'll explain what we are trying to do. Since all of our layer names have a number in the name we have used that number as the corresponding sketch name in the excel spread sheet. The reason we have done this is because there are times that we will have multiple sketches in the same part that need to be assigned to the same layer but since you can't have duplicate sketch names in the same part we figure we would just name the sketches whatever we wanted only each one would be appended with a "-" and then the corresponding number that is unique to each layer. for example we have layer "OUTSIDE.75POLY.5BIT(4)" so we would name our sketches like so "sketch1-4", "Sketch2-4" and so on. Then in the code I have added a couple lines that will get the sketch name and split it at the "-" and return everything after the "-" then the result will be just the number. This way even if there are multiple sketches that require the same layer we can name them uniquely but they will still have the layer number so that the rest of the code can run and assign the layer to the collective segments. What I have added works with one exception. If there is a sketch name that does not have a dash Then I get an error "Index was outside the bounds of the array." It works fine if there is a "-" with nothing after it or with anything that does not match a layer number. I just can't figure out how to have it skip over a sketch if there is no "-" Here is the code you gave me with my additions, any help you can give me would appreciated.

AddReference "System.XML.dll"
AddReference "System.Data.dll"
Sub Main()
	Dim oDoc As Document = ThisApplication.ActiveDocument
	If oDoc.DocumentType <> DocumentTypeEnum.kDrawingDocumentObject Then Exit Sub
	Dim oActiveSheet As Sheet = oDoc.ActiveSheet
	Dim oView As DrawingView = oActiveSheet.DrawingViews(1)
	Dim oRefDoc As AssemblyDocument = oView.ReferencedDocumentDescriptor.ReferencedDocument
	Dim oAssDef As AssemblyComponentDefinition = oRefDoc.ComponentDefinition
	Dim oOcc As ComponentOccurrence = oAssDef.Occurrences(1)
	Dim oPart As PartDocument = oOcc.Definition.Document
	Dim oDef As PartComponentDefinition = oPart.ComponentDefinition
	
	AddDT()

	For Each oSketch As PlanarSketch In oDef.Sketches
'I added from here
		Dim oGetSketchName As String = oSketch.Name
		Dim oExtractLayerNum As String() = oGetSketchName.Split("-")
		Dim oLayerNum As String = oExtractLayerNum(1)
'To here

		Dim oLayerName As String = GetLayerName(oLayerNum) 'And changed This from (oSketch.Name) to (oLayerNum)
		If oLayerName = vbNullString Then Continue For
		Dim oProxy As PlanarSketchProxy
		oOcc.CreateGeometryProxy(oSketch, oProxy)
		Dim oTO As TransientObjects = ThisApplication.TransientObjects
		Dim oColl As ObjectCollection = oTO.CreateObjectCollection()
			
		Dim oCurves As DrawingCurvesEnumerator = oView.DrawingCurves(oProxy)
		For Each oCurve As DrawingCurve In oCurves
			For Each oSegment As DrawingCurveSegment In oCurve.Segments
				oColl.Add(oSegment)
			Next
		Next
		
		Dim oLayer As Layer = oDoc.StylesManager.Layers.Item(oLayerName)
		If oLayer Is Nothing Then Continue For
		Call oView.Parent.ChangeLayer(oColl, oLayer)
	Next
End Sub

Private DT As System.Data.DataTable

Sub AddDT()
	DT = New System.Data.DataTable
	DT.Columns.Add("Sketch", GetType(String))
	DT.Columns.Add("Layer", GetType(String))
	GoExcel.Open("MasterLayerList.xlsx")
	For rowNumber = 2 To 10000
		Dim S As String = GoExcel.CellValue("A" & rowNumber)
		Dim L As String = GoExcel.CellValue("B" & rowNumber)
		If S = vbNullString Then Exit For
		DT.Rows.Add(S, L)
	Next
End Sub

Function GetLayerName(oSketchName As String) As String
	If DT Is Nothing Then Return vbNullString
	If DT.Rows.Count = 0 Then Return vbNullString
	Dim oRow() As System.Data.DataRow = DT.Select("Sketch = '" & oSketchName & "'")
	If oRow.Length = 0 Then Return vbNullString
	Return oRow(0)("Layer").ToString
End Function

[Owner2229 · Accepted solution]

Here you go:

AddReference "System.XML.dll"
AddReference "System.Data.dll"
Sub Main()
	Dim oDoc As Document = ThisApplication.ActiveDocument
	If oDoc.DocumentType <> DocumentTypeEnum.kDrawingDocumentObject Then Exit Sub
	Dim oActiveSheet As Sheet = oDoc.ActiveSheet
	Dim oView As DrawingView = oActiveSheet.DrawingViews(1)
	Dim oRefDoc As AssemblyDocument = oView.ReferencedDocumentDescriptor.ReferencedDocument
	Dim oAssDef As AssemblyComponentDefinition = oRefDoc.ComponentDefinition
	Dim oOcc As ComponentOccurrence = oAssDef.Occurrences(1)
	Dim oPart As PartDocument = oOcc.Definition.Document
	Dim oDef As PartComponentDefinition = oPart.ComponentDefinition
	
	AddDT()

	For Each oSketch As PlanarSketch In oDef.Sketches
		Dim oSketchName As String = oSketch.Name
		Dim FNP As Integer = InStrRev(oSketchName, "-", -1)
		If FNP = 0 Then Continue For 'Catch non-present "-"
		If FNP = Len(oSketchName) Then Continue For 'Catch "-" at the end
		oSketchName = Mid(oSketchName, FNP + 1)
		If Not IsNumeric(oSketchName) Then Continue For 'Check if it's a number

		Dim oLayerName As String = GetLayerName(oSketchName)
		If oLayerName = vbNullString Then Continue For
		Dim oProxy As PlanarSketchProxy
		oOcc.CreateGeometryProxy(oSketch, oProxy)
		Dim oTO As TransientObjects = ThisApplication.TransientObjects
		Dim oColl As ObjectCollection = oTO.CreateObjectCollection()
			
		Dim oCurves As DrawingCurvesEnumerator = oView.DrawingCurves(oProxy)
		For Each oCurve As DrawingCurve In oCurves
			For Each oSegment As DrawingCurveSegment In oCurve.Segments
				oColl.Add(oSegment)
			Next
		Next
		
		Dim oLayer As Layer = oDoc.StylesManager.Layers.Item(oLayerName)
		If oLayer Is Nothing Then Continue For
		Call oView.Parent.ChangeLayer(oColl, oLayer)
	Next
End Sub

Private DT As System.Data.DataTable

Sub AddDT()
	DT = New System.Data.DataTable
	DT.Columns.Add("Sketch", GetType(String))
	DT.Columns.Add("Layer", GetType(String))
	GoExcel.Open("MasterLayerList.xlsx")
	For rowNumber = 2 To 10000
		Dim S As String = GoExcel.CellValue("A" & rowNumber)
		Dim L As String = GoExcel.CellValue("B" & rowNumber)
		If S = vbNullString Then Exit For
		DT.Rows.Add(S, L)
	Next
End Sub

Function GetLayerName(oSketchName As String) As String
	If DT Is Nothing Then Return vbNullString
	If DT.Rows.Count = 0 Then Return vbNullString
	Dim oRow() As System.Data.DataRow = DT.Select("Sketch = '" & oSketchName & "'")
	If oRow.Length = 0 Then Return vbNullString
	Return oRow(0)("Layer").ToString
End Function

[They_Call_Me_Jake]

Mike, I ran into an issue I hadn't thought of before. There are times that the drawing view contains only a part and not a part in an assembly and I get an error when it loops to said view. I have tried to adjust the latest code you wrote to handle a drawing view with just a part in it by using an If statement to determine what the referenced file type is and that part seems to work. Where i'm getting  hung up is in the PlanarSketchProxy area. I see that the CreateGeometryProxy is for Assemblies and if I try to comment out the PlanarSketchProxy line (line 37) and the CreateGeometryProxy line (line 38) it finds the views that only have a part in them but then as it loops thru all the sketches it finds the layer that is supposed to be for the first sketch but sets all the sketches to that layer and then the same thing for the next sketch in the loop and so on so that when its done it has set every sketch to the same layer even tho there a say 10 different layers that needed to be assigned. Here's the code that I have with my adjustments. One other thing that I added was a For Loop to loop thru each of the drawing views on the sheet. which seems to work well as long as they are all views with assemblies. I'm glad I tested something before I sent this off. Now that I am looping thru all the views there are some instances where we will have a view that has sub-assemblies in a main assembly. We don't use this view for assigning layers to sketches but since the code I have is not written to handle a view with sub-assemblies in an assembly I get an error on that as well so I'm not sure how to go about having the loop skip over a view like this. So as a recap to my long explanation. I am trying to have the code loop thru all of the views on a sheet, skip over a view if there are sub-assemblies in an assembly but assign the proper layer to the proper sketches as before to views that have just a part in it and to views that could have multiple parts in an assembly which now that I look at the code would mean I need a loop for the oAssDef.Occurrences (Line 21). Mike I'm sorry....I know that I keep adding things and you are being very patient with me and keep helping me out. I am very appreciative of the help you have given me. If you are ever in Orlando Florida let me know and I'll buy you a beer.

AddReference "System.XML.dll"
AddReference "System.Data.dll"
Sub Main()
	Dim oDoc As Document = ThisApplication.ActiveDocument
	If oDoc.DocumentType <> DocumentTypeEnum.kDrawingDocumentObject Then Exit Sub
	Dim oActiveSheet As Sheet = oDoc.ActiveSheet
	Dim oView As DrawingView
	For Each oView In oActiveSheet.DrawingViews	
		Dim oRefFileDesc As ReferencedFileDescriptor = oView.ReferencedFile
		Dim oRefDoc As AssemblyDocument
		Dim oAssDef As AssemblyComponentDefinition
		Dim oOcc As ComponentOccurrence
		Dim oPart As PartDocument
		Dim oDef As PartComponentDefinition
		If (TypeOf oRefFileDesc.ReferencedDocument Is PartDocument) Then
			oPart = oRefFileDesc.ReferencedDocument
			oDef = oPart.ComponentDefinition
		Else If (TypeOf oRefFileDesc.ReferencedDocument Is AssemblyDocument) Then		
			oRefDoc = oView.ReferencedDocumentDescriptor.ReferencedDocument
			oAssDef = oRefDoc.ComponentDefinition
			oOcc = oAssDef.Occurrences(1)
			oPart = oOcc.Definition.Document
			oDef = oPart.ComponentDefinition
		End If 
		
		AddDT()

		For Each oSketch As PlanarSketch In oDef.Sketches
			Dim oSketchName As String = oSketch.Name
			Dim FNP As String = InStrRev(oSketchName, "-", -1)
			If FNP = 0 Then Continue For 'Catch non-present "-"
			If FNP = Len(oSketchName) Then Continue For 'Catch "-" at the end
			oSketchName = Mid(oSketchName, FNP + 1)
			If Not IsNumeric(oSketchName) Then Continue For 'Check if it's a number
			Dim oLayerName As String = GetLayerName(oSketchName)
			If oLayerName = vbNullString Then Continue For
			Dim oProxy As PlanarSketchProxy
			oOcc.CreateGeometryProxy(oSketch, oProxy)
			Dim oTO As TransientObjects = ThisApplication.TransientObjects
			Dim oColl As ObjectCollection = oTO.CreateObjectCollection()
				
			Dim oCurves As DrawingCurvesEnumerator = oView.DrawingCurves(oProxy)
			For Each oCurve As DrawingCurve In oCurves
				For Each oSegment As DrawingCurveSegment In oCurve.Segments
					oColl.Add(oSegment)
				Next
			Next
		
			Dim oLayer As Layer = oDoc.StylesManager.Layers.Item(oLayerName)
			If oLayer Is Nothing Then Continue For
			Call oView.Parent.ChangeLayer(oColl, oLayer)
		Next
	Next
End Sub

Private DT As System.Data.DataTable

Sub AddDT()
	DT = New System.Data.DataTable
	DT.Columns.Add("Sketch", GetType(String))
	DT.Columns.Add("Layer", GetType(String))
	GoExcel.Open("MasterLayerList.xlsx")
	For rowNumber = 2 To 10000
		Dim S As String = GoExcel.CellValue("A" & rowNumber)
		Dim L As String = GoExcel.CellValue("B" & rowNumber)
		If S = vbNullString Then Exit For
		DT.Rows.Add(S, L)
	Next
End Sub

Function GetLayerName(oSketchName As String) As String
	If DT Is Nothing Then Return vbNullString
	If DT.Rows.Count = 0 Then Return vbNullString
	Dim oRow() As System.Data.DataRow = DT.Select("Sketch = '" & oSketchName & "'")
	If oRow.Length = 0 Then Return vbNullString
	Return oRow(0)("Layer").ToString
End Function

[Owner2229]

Try it like this and let me know. I'm really sleepy, so I can't think of anything better atm. I'll look at it tomorrow (if this won't work).

Now I'm going to enjoy my 5 hours of sleep.

AddReference "System.XML.dll"
AddReference "System.Data.dll"
Sub Main()
	Dim oDoc As Document = ThisApplication.ActiveDocument
	If oDoc.DocumentType <> DocumentTypeEnum.kDrawingDocumentObject Then Exit Sub
	Dim oActiveSheet As Sheet = oDoc.ActiveSheet
	For Each oView As DrawingView In oActiveSheet.DrawingViews	
		Dim oRefDoc As Document = oView.ReferencedDocumentDescriptor.ReferencedDocument
		Dim oCD As ComponentDefinition = oRefDoc.ComponentDefinition
		Dim IsAssy As Boolean = (oRefDoc.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject)
		Dim oOcc As ComponentOccurrence = Nothing
		If IsAssy Then
			oOcc = oAssDef.Occurrences(1)
			oRefDoc = oOcc.Definition.Document
			oCD = oRefDoc.ComponentDefinition
			If oRefDoc.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject Then Continue For
		End If
		
		AddDT()

		For Each oSketch As PlanarSketch In oCD.Sketches
			Dim oSketchName As String = oSketch.Name
			Dim FNP As String = InStrRev(oSketchName, "-", -1)
			If FNP = 0 Then Continue For 'Catch non-present "-"
			If FNP = Len(oSketchName) Then Continue For 'Catch "-" at the end
			oSketchName = Mid(oSketchName, FNP + 1)
			If Not IsNumeric(oSketchName) Then Continue For 'Check if it's a number
			Dim oLayerName As String = GetLayerName(oSketchName)
			If oLayerName = vbNullString Then Continue For
			Dim oTO As TransientObjects = ThisApplication.TransientObjects
			Dim oColl As ObjectCollection = oTO.CreateObjectCollection()
			Dim oCurves As DrawingCurvesEnumerator
			If IsAssy Then
				Dim oProxy As PlanarSketchProxy
				oOcc.CreateGeometryProxy(oSketch, oProxy)
				oCurves = oView.DrawingCurves(oProxy)
			Else
				oCurves = oView.DrawingCurves(oSketch)
			End If
			For Each oCurve As DrawingCurve In oCurves
				For Each oSegment As DrawingCurveSegment In oCurve.Segments
					oColl.Add(oSegment)
				Next
			Next
		
			Dim oLayer As Layer = oDoc.StylesManager.Layers.Item(oLayerName)
			If oLayer Is Nothing Then Continue For
			Call oView.Parent.ChangeLayer(oColl, oLayer)
		Next
	Next
End Sub

Private DT As System.Data.DataTable

Sub AddDT()
	DT = New System.Data.DataTable
	DT.Columns.Add("Sketch", GetType(String))
	DT.Columns.Add("Layer", GetType(String))
	GoExcel.Open("MasterLayerList.xlsx")
	For rowNumber = 2 To 10000
		Dim S As String = GoExcel.CellValue("A" & rowNumber)
		Dim L As String = GoExcel.CellValue("B" & rowNumber)
		If S = vbNullString Then Exit For
		DT.Rows.Add(S, L)
	Next
End Sub

Function GetLayerName(oSketchName As String) As String
	If DT Is Nothing Then Return vbNullString
	If DT.Rows.Count = 0 Then Return vbNullString
	Dim oRow() As System.Data.DataRow = DT.Select("Sketch = '" & oSketchName & "'")
	If oRow.Length = 0 Then Return vbNullString
	Return oRow(0)("Layer").ToString
End Function

[They_Call_Me_Jake]

I got an error that the oAssDef was not declared so I added this line,

Dim oAssDef As AssemblyComponentDefinition

after line 10 and now I get this error

Object reference not set to an instance of an object.

[Owner2229]

Alright, try it now:

AddReference "System.XML.dll"
AddReference "System.Data.dll"
Sub Main()
	Dim oDoc As Document = ThisApplication.ActiveDocument
	If oDoc.DocumentType <> DocumentTypeEnum.kDrawingDocumentObject Then Exit Sub
	Dim oActiveSheet As Sheet = oDoc.ActiveSheet
	For Each oView As DrawingView In oActiveSheet.DrawingViews	
		Dim oRefDoc As Document = oView.ReferencedDocumentDescriptor.ReferencedDocument
		Dim oCD As ComponentDefinition = oRefDoc.ComponentDefinition
		Dim IsAssy As Boolean = (oRefDoc.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject)
		Dim oOcc As ComponentOccurrence = Nothing
		If IsAssy Then
			If oCD.Occurrences.Count = 0 Then Continue For
			oOcc = oCD.Occurrences(1)
			oRefDoc = oOcc.Definition.Document
			oCD = oRefDoc.ComponentDefinition
			If oRefDoc.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject Then Continue For
		End If
		
		AddDT()

		For Each oSketch As PlanarSketch In oCD.Sketches
			Dim oSketchName As String = oSketch.Name
			Dim FNP As String = InStrRev(oSketchName, "-", -1)
			If FNP = 0 Then Continue For 'Catch non-present "-"
			If FNP = Len(oSketchName) Then Continue For 'Catch "-" at the end
			oSketchName = Mid(oSketchName, FNP + 1)
			If Not IsNumeric(oSketchName) Then Continue For 'Check if it's a number
			Dim oLayerName As String = GetLayerName(oSketchName)
			If oLayerName = vbNullString Then Continue For
			Dim oTO As TransientObjects = ThisApplication.TransientObjects
			Dim oColl As ObjectCollection = oTO.CreateObjectCollection()
			Dim oCurves As DrawingCurvesEnumerator
			If IsAssy Then
				Dim oProxy As PlanarSketchProxy
				oOcc.CreateGeometryProxy(oSketch, oProxy)
				oCurves = oView.DrawingCurves(oProxy)
			Else
				oCurves = oView.DrawingCurves(oSketch)
			End If
			For Each oCurve As DrawingCurve In oCurves
				For Each oSegment As DrawingCurveSegment In oCurve.Segments
					oColl.Add(oSegment)
				Next
			Next
		
			Dim oLayer As Layer = oDoc.StylesManager.Layers.Item(oLayerName)
			If oLayer Is Nothing Then Continue For
			Call oView.Parent.ChangeLayer(oColl, oLayer)
		Next
	Next
End Sub

Private DT As System.Data.DataTable

Sub AddDT()
	DT = New System.Data.DataTable
	DT.Columns.Add("Sketch", GetType(String))
	DT.Columns.Add("Layer", GetType(String))
	GoExcel.Open("MasterLayerList.xlsx")
	For rowNumber = 2 To 10000
		Dim S As String = GoExcel.CellValue("A" & rowNumber)
		Dim L As String = GoExcel.CellValue("B" & rowNumber)
		If S = vbNullString Then Exit For
		DT.Rows.Add(S, L)
	Next
End Sub

Function GetLayerName(oSketchName As String) As String
	If DT Is Nothing Then Return vbNullString
	If DT.Rows.Count = 0 Then Return vbNullString
	Dim oRow() As System.Data.DataRow = DT.Select("Sketch = '" & oSketchName & "'")
	If oRow.Length = 0 Then Return vbNullString
	Return oRow(0)("Layer").ToString
End Function

[They_Call_Me_Jake]

Mike, no errors now and everything works except if there are multiple parts in an assembly it only adjusts the layers in the occurrence number that is hard set. I'm trying different ways to add a for loop to try and loop thru each of the occurrences of an assembly but it seems every way it still only gets one of the occurrences and then it skips the view that only has a part in it. I'm still trying to figure it out but if you can maybe give me a clue where it would go then that would help. Unless of coarse a bunch of stuff needs to be re-written to make that work then I guess I'm lost. I think this is the last thing I need to change before I can push it to all my models. Thanks again for your help.

[Owner2229 · Accepted solution]

Ok, this should do the trick:

AddReference "System.XML.dll"
AddReference "System.Data.dll"
Sub Main()
	Dim oDoc As Document = ThisApplication.ActiveDocument
	If oDoc.DocumentType <> DocumentTypeEnum.kDrawingDocumentObject Then Exit Sub
	Dim oActiveSheet As Sheet = oDoc.ActiveSheet
	
	AddDT()
	
	For Each oView As DrawingView In oActiveSheet.DrawingViews	
		Dim oRefDoc As Document = oView.ReferencedDocumentDescriptor.ReferencedDocument
		Dim oCD As ComponentDefinition = oRefDoc.ComponentDefinition
		Dim IsAssy As Boolean = (oRefDoc.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject)
		If Not IsAssy Then
			Work_a_File(oDoc, oView, Nothing, oCD)
		Else
			If oCD.Occurrences.Count = 0 Then Continue For
			For Each oOcc As ComponentOccurrence In oCD.Occurrences
				oRefDoc = oOcc.Definition.Document
				If oRefDoc.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject Then Continue For
				oCD = oRefDoc.ComponentDefinition
				Work_a_File(oDoc, oView, oOcc, oCD)
			Next
		End If
	Next
End Sub

Private Sub Work_a_File(oDoc As Document, oView As DrawingView, oOcc As ComponentOccurrence, oCD As ComponentDefinition)
	For Each oSketch As PlanarSketch In oCD.Sketches
		Dim oSketchName As String = oSketch.Name
		Dim FNP As String = InStrRev(oSketchName, "-", -1)
		If FNP = 0 Then Continue For 'Catch non-present "-"
		If FNP = Len(oSketchName) Then Continue For 'Catch "-" at the end
		oSketchName = Mid(oSketchName, FNP + 1)
		If Not IsNumeric(oSketchName) Then Continue For 'Check if it's a number
		Dim oLayerName As String = GetLayerName(oSketchName)
		If oLayerName = vbNullString Then Continue For
		Dim oTO As TransientObjects = ThisApplication.TransientObjects
		Dim oColl As ObjectCollection = oTO.CreateObjectCollection()
		Dim oCurves As DrawingCurvesEnumerator
		If oOcc IsNot Nothing Then
			Dim oProxy As PlanarSketchProxy
			oOcc.CreateGeometryProxy(oSketch, oProxy)
			oCurves = oView.DrawingCurves(oProxy)
		Else
			oCurves = oView.DrawingCurves(oSketch)
		End If
		For Each oCurve As DrawingCurve In oCurves
			For Each oSegment As DrawingCurveSegment In oCurve.Segments
				oColl.Add(oSegment)
			Next
		Next
	
		Dim oLayer As Layer = oDoc.StylesManager.Layers.Item(oLayerName)
		If oLayer Is Nothing Then Continue For
		Call oView.Parent.ChangeLayer(oColl, oLayer)
	Next
End Sub

Private DT As System.Data.DataTable

Sub AddDT()
	DT = New System.Data.DataTable
	DT.Columns.Add("Sketch", GetType(String))
	DT.Columns.Add("Layer", GetType(String))
	GoExcel.Open("MasterLayerList.xlsx")
	For rowNumber = 2 To 10000
		Dim S As String = GoExcel.CellValue("A" & rowNumber)
		Dim L As String = GoExcel.CellValue("B" & rowNumber)
		If S = vbNullString Then Exit For
		DT.Rows.Add(S, L)
	Next
End Sub

Function GetLayerName(oSketchName As String) As String
	If DT Is Nothing Then Return vbNullString
	If DT.Rows.Count = 0 Then Return vbNullString
	Dim oRow() As System.Data.DataRow = DT.Select("Sketch = '" & oSketchName & "'")
	If oRow.Length = 0 Then Return vbNullString
	Return oRow(0)("Layer").ToString
End Function  

[They_Call_Me_Jake]

That did the trick. Also it is much faster then the other ways. Before it would go thru each view and you could see the layers changing one by one. Now it has about the same process time as it did for doing just one view only when you see it change every view and every sketch changes all at once. Much faster, I love it. You are awesome. Thank you so much.