Move subassembly part to layer

[patrick3HNXX]

Hello,

I have panels that contain expanded sheets that I would like move to a separate layer called "Expanded Sheets" in my drawing. I have experimented with a few options but the problem is that the expanded sheet is actually drawn in 3D.....so many many many lines. I got a loop to work but it takes forever because it individually selects each object, then moves it to the specified layer. I think the best / fastest approach is to do something similar to "Select as Edges", using the part name then move it to the layer but I am not sure how to access that function.

Patrick

[Ralf_Krieg]

Hello

Use the DrawingView.DrawingCurves( [ModelObject] As Variant ) property, which gives you a DrawingCurvesEnumerator. Traverse through the enumerator and add every visible DrawingCurveSegment to an ObjectCollection. Use the Sheet.ChangeLayer( Objects As ObjectCollection, Layer As Layer ) method to set the layer for all objects at once.

[Curtis_Waguespack]

Hi @patrick3HNXX 

Here is an example iLogic rule to do this. This is based on an example from these forums posted in the past. 

It looks for part files ( in a subassembly or not in a subassembly) that contain the name "Expanded Sheet" and it selects the edges in the drawing of those parts and move them to the layer called "Expanded Sheets". 

I hope this helps.
Best of luck to you in all of your Inventor pursuits,
Curtis
http://inventortrenches.blogspot.com

Class ThisRule
	Public oTargetName As String
	Public oTargetLayer As String

	Sub Main

		oTargetName = "Expanded Sheet"
		oTargetLayer = "Expanded Sheets"

		If ThisApplication.ActiveDocument.DocumentType <> _
			DocumentTypeEnum.kDrawingDocumentObject Then Return 'exit rule

		' Get the active drawing document. 
		Dim oDoc As DrawingDocument
		oDoc = ThisApplication.ActiveDocument


		Dim oSheets As Sheets
		oSheets = oDoc.Sheets
		Dim oSheet As Sheet

		'get current sheet so it can
		'be made active again later
		Dim oCurrentSheet As Sheet
		oCurrentSheet = oDoc.ActiveSheet

		Dim oViews As DrawingViews
		Dim oView As DrawingView

		' Iterate through the sheets
		For Each oSheet In oSheets
			'activate the sheet
			oSheet.Activate

			'get the collection of view on the sheet
			oViews = oSheet.DrawingViews

			' Iterate through the views on the sheet
			For Each oView In oViews

				Dim docDesc As DocumentDescriptor
				docDesc = oView.ReferencedDocumentDescriptor

				' Verify that the drawing view is of an assembly. 
				If docDesc.ReferencedDocumentType <> kAssemblyDocumentObject Then
					Continue For
				End If

				' Get the component definition for the assembly. 
				Dim asmDef As AssemblyComponentDefinition
				asmDef = 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 recursive function that does all the work. 
				Call ProcessAssemblyColor(oView, asmDef.Occurrences)
				trans.End
			Next
			'update the sheet
			oSheet.Update
		Next

		'return to original sheet	
		oCurrentSheet.Activate

	End Sub


	Private Sub ProcessAssemblyColor(drawView As DrawingView, _
		Occurrences As ComponentOccurrences)

		Logger.Info("------------" & drawView.Name)
		' 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
				If Not occ.Name.Contains(oTargetName) Then Continue For
				Logger.Info(occ.Name)
				' ** It's a part so process the layer

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

				Dim oLayers As LayersEnumerator
				oLayers = drawView.Parent.Parent.StylesManager.layers

				Dim oLayer As Layer
				oLayer = oLayers.Item(oTargetLayer)

				Dim oDoc As DrawingDocument
				oDoc = drawView.Parent.Parent

				' Get all of the curves associated with this occurrence. 
				On Error Resume Next
				Dim drawcurves As DrawingCurvesEnumerator
				drawcurves = drawView.DrawingCurves(occ)
				If Err.Number = 0 Then
					On Error GoTo 0

					' Create an empty collection. 
					Dim objColl As ObjectCollection
					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, oLayer)
				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
End Class

[patrick3HNXX]

Unspecified error (Exception from HRESULT: 0x80004005 (E_FAIL))

Call ProcessAssemblyColor(drawView, occ.SubOccurrences)

getting an error on this line

[Curtis_Waguespack]

Hi @patrick3HNXX,

That's not much information to trouble shoot on, but I took some guesses as to what your drawing/assembly might have present that would produce errors and added some error catches. 

If this version doesn't work, please let me know what version of Inventor you are using, and I'll try to provide a simple example file set, so that you can see this work and compare to your files.

I hope this helps.
Best of luck to you in all of your Inventor pursuits,
Curtis
http://inventortrenches.blogspot.com

Class ThisRule
	Public oTargetName As String
	Public oTargetLayer As String

	Sub Main

		oTargetName = "Expanded Sheet"
		oTargetLayer = "Expanded Sheets"

		If ThisApplication.ActiveDocument.DocumentType <> _
		DocumentTypeEnum.kDrawingDocumentObject Then Return 'exit rule

		' Get the active drawing document. 
		Dim oDoc As DrawingDocument
		oDoc = ThisApplication.ActiveDocument

		Dim oLayers As LayersEnumerator
		oLayers = oDoc.StylesManager.Layers

		Dim oLayer As Layer
		For Each xLayer In oLayers
			If xLayer.name = oTargetLayer Then
				oLayer = xLayer
				Exit For
			End If
		Next

		If oLayer Is Nothing Then
			MsgBox("No layer named """ & oTargetLayer & """ was found in this drawing." _
			& vbLf & vbLf & "Cannot continue.", , "iLogic")
			Exit Sub
		End If

		Dim oSheets As Sheets
		oSheets = oDoc.Sheets
		Dim oSheet As Sheet

		'get current sheet so it can
		'be made active again later
		Dim oCurrentSheet As Sheet
		oCurrentSheet = oDoc.ActiveSheet

		Dim oViews As DrawingViews
		Dim oView As DrawingView

		' Iterate through the sheets
		For Each oSheet In oSheets
			'activate the sheet
			oSheet.Activate

			'get the collection of view on the sheet
			oViews = oSheet.DrawingViews

			' Iterate through the views on the sheet
			For Each oView In oViews

				If oView.ReferencedDocumentDescriptor is nothing Then Continue For
					
				Dim docDesc As DocumentDescriptor
				docDesc = oView.ReferencedDocumentDescriptor

				' Verify that the drawing view is of an assembly. 
				If docDesc.ReferencedDocumentType <> kAssemblyDocumentObject Then
					Continue For
				End If

				' Get the component definition for the assembly. 
				Dim asmDef As AssemblyComponentDefinition
				asmDef = 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 recursive function that does all the work. 
				Call ProcessAssemblyColor(oView, asmDef.Occurrences)
				trans.End
			Next
			'update the sheet
			oSheet.Update
		Next

		'return to original sheet	
		oCurrentSheet.Activate

	End Sub


	Private Sub ProcessAssemblyColor(drawView As DrawingView, _
		Occurrences As ComponentOccurrences)

		Logger.Info("------------" & drawView.Name)
		' 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
				If Not occ.Name.Contains(oTargetName) Then Continue For
				Logger.Info(occ.Name)
				' ** It's a part so process the layer

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

				Dim oLayers As LayersEnumerator
				oLayers = drawView.Parent.Parent.StylesManager.layers

				Dim oLayer As Layer
				oLayer = oLayers.Item(oTargetLayer)

				Dim oDoc As DrawingDocument
				oDoc = drawView.Parent.Parent

				' Get all of the curves associated with this occurrence. 
				On Error Resume Next
				Dim drawcurves As DrawingCurvesEnumerator
				drawcurves = drawView.DrawingCurves(occ)
				If Err.Number = 0 Then
					On Error GoTo 0

					' Create an empty collection. 
					Dim objColl As ObjectCollection
					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, oLayer)
				End If
				On Error GoTo 0
			ElseIf occ.DefinitionDocumentType = kAssemblyDocumentObject Then
				' It's an assembly so process its contents. 
				Call ProcessAssemblyColor(drawView, occ.SubOccurrences)
			Else
				Continue for
			End If
		Next
	End Sub
End Class

[patrick3HNXX]

Sorry for the delayed response. I got sucked into a vortex of a project and haven't gotten back to this.

I attached a zip file of typical panel used. I am using 2022 Pro.

[Curtis_Waguespack · Accepted solution]

Hi @patrick3HNXX 

Using your data set I needed to change the target name to just Expanded, and then then it worked (assuming the named layer was in the drawing).

I hope this helps.
Best of luck to you in all of your Inventor pursuits,
Curtis
http://inventortrenches.blogspot.com