Change Component Property in Drawing

[hieut1392]

Hi everybody.

I want to write a macro to change color, line type, line weight by selecting part in the assembly drawing, but I want to change part color in only 1 view, other views have no effect.

The code below is what I collected from the forum. This code changes the part color in all views.

I have edited it a bit the way I understand it.

Can you help me edit the code according to my wishes? Or if you have better code, please share me.

Option Explicit

Sub Main()
    
Dim oDoc As DrawingDocument
Set oDoc = ThisApplication.ActiveDocument

Dim partStr As String
partStr = GetPartName()

Dim oTrans As Transaction
Dim ViewCurves As DrawingCurvesEnumerator
Dim refAssyDef As ComponentDefinition
Dim oColor As color

Set oColor = ThisApplication.TransientObjects.CreateColor(255, 0, 0)
Set oTrans = ThisApplication.TransactionManager.StartTransaction(ThisApplication.ActiveDocument, "Colorize [PART]")

Dim i As sheet
Dim j As DrawingView
Dim k As ComponentOccurrence
Dim c As DrawingCurve

For Each i In oDoc.Sheets

    For Each j In i.DrawingViews

        If j.ReferencedDocumentDescriptor.ReferencedDocumentType = kPresentationDocumentObject Then
            Set refAssyDef = j.ReferencedDocumentDescriptor.ReferencedDocument.ReferencedDocuments(1).ComponentDefinition
        ElseIf j.ReferencedFile.DocumentType = kAssemblyDocumentObject Then
            Set refAssyDef = j.ReferencedFile.DocumentDescriptor.ReferencedDocument.ComponentDefinition
        End If

        For Each k In refAssyDef.Occurrences

            If k.name = partStr Then
            
            Set ViewCurves = j.DrawingCurves(k)
            
                For Each c In ViewCurves
                    c.color = oColor
                    c.LineType = kDashDottedLineType
                    c.LineWeight = 0.05
                Next
                
            End If
        Next
    Next
Next

oTrans.End
  
End Sub

Function GetPartName() As String

Dim oOccioV As DrawingCurveSegment
Set oOccioV = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kDrawingCurveSegmentFilter, "Seleziona Componente")

Dim oView As DrawingView
Set oView = oOccioV.Parent.Parent

Dim oToccoH As Object
Set oToccoH = oOccioV.Parent.ModelGeometry.Parent.Parent

GetPartName = oToccoH.name

End Function

[WCrihfield · Accepted solution]

Hi @hieut1392.  If you want to be able to change the color, line type, or line weight of that view geometry after the code has finished, then I would recommend that you put all that geometry on a custom Layer, instead of changing those properties of each individual curve.  The custom layer can have all those settings set the way you want it.  If the code put all that geometry on a custom layer, then you will have a few advantages.  You will be able to control that manually, in the Layers dialog.  You can easily delete that layer, if you want to.  You can easily find that geometry again, by its layer.  There is a Sheet level method (Sheet.ChangeLayer) that can be used in a situation like this.  First you would put all those curves into an ObjectCollection, then supply that to the method, along with what Layer to change it to.  But that custom Layer must either already exist, or you must create it within the code first.  Below is an example of a code like that, if you want to try it out.  But you may want to change the name of the Layer first, or manually create the layer ahead of time, then change the name being specified within the code.

Sub Main
	If ThisApplication.ActiveDocumentType <> DocumentTypeEnum.kDrawingDocumentObject Then Exit Sub
	Dim oFilter As SelectionFilterEnum = SelectionFilterEnum.kDrawingCurveSegmentFilter
	Dim sPrompt As String = "Select drawing view curve of assembly component."
	Dim oPickedDCS As DrawingCurveSegment = ThisApplication.CommandManager.Pick(oFilter, sPrompt)
	If oPickedDCS Is Nothing Then Exit Sub
	Dim oView As DrawingView = oPickedDCS.Parent.Parent
	Dim oOcc As ComponentOccurrence = GetCurveComponent(oPickedDCS)
	If oOcc Is Nothing Then Exit Sub
	Dim oDCurves As DrawingCurvesEnumerator = Nothing
	Try : oDCurves = oView.DrawingCurves(oOcc) : Catch : End Try
	If oDCurves Is Nothing OrElse oDCurves.Count = 0 Then Exit Sub
	Dim oColl As ObjectCollection = ThisApplication.TransientObjects.CreateObjectCollection
	For Each oDC As DrawingCurve In oDCurves
		Dim oDCSs As DrawingCurveSegments = oDC.Segments
		For Each oDCS As DrawingCurveSegment In oDCSs
			oColl.Add(oDCS)
		Next
	Next
	If oColl.Count = 0 Then Exit Sub
	Dim oSheet As Inventor.Sheet = oView.Parent
	Dim oDDoc As DrawingDocument = oSheet.Parent
	Dim oLayers As Inventor.LayersEnumerator = oDDoc.StylesManager.Layers
	Dim oLayer As Inventor.Layer = Nothing
	'<<< EDIT LAYER NAME AS NEEDED >>>
	Try : oLayer = oLayers.Item("MyCustomLayer") : Catch : End Try
	If oLayer Is Nothing Then
		oLayer = oLayers.Item(1).Copy("MyCustomLayer")
		oLayer.Color = ThisApplication.TransientObjects.CreateColor(255, 0, 0)
		oLayer.LineType = LineTypeEnum.kDashDottedLineType
		oLayer.LineWeight = 0.05
	End If
	oView.Parent.ChangeLayer(oColl, oLayer)
	If oDDoc.RequiresUpdate Then oDDoc.Update2(True)
End Sub

Function GetCurveComponent(oDCS) As ComponentOccurrence
	If oDCS Is Nothing Then Return Nothing
	Dim oMG As Object = oDCS.Parent.ModelGeometry
	Dim oEdge As Edge = Nothing: Try : oEdge = oMG.Parent : Catch : End Try
	If oEdge Is Nothing Then Return Nothing
	Dim oBody As SurfaceBody = oEdge.Parent
	Dim oOcc As ComponentOccurrence = Nothing
	Try : oOcc = oBody.Parent : Catch : End Try
	If oOcc IsNot Nothing Then Return oOcc Else Return Nothing
End Function

If this solved your problem, or answered your question, please click ACCEPT SOLUTION .
Or, if this helped you, please click (LIKE or KUDOS) 👍.

[hieut1392]

Even though I had to convert to VBA code, thank you very much.

vba code for who need it.

Sub Main()

Repeat:
   
Dim oPickedDCS As DrawingCurveSegment
Set oPickedDCS = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kDrawingCurveSegmentFilter, "Pick edge")

If (Not oPickedDCS Is Nothing) Then
    
    Dim oView As DrawingView
    Set oView = oPickedDCS.Parent.Parent
    
    Dim oOcc As ComponentOccurrence
    Set oOcc = oPickedDCS.Parent.ModelGeometry.Parent.Parent
    
    Dim oDCurves As DrawingCurvesEnumerator
    Set oDCurves = oView.DrawingCurves(oOcc)
    
    Dim oColl As ObjectCollection
    Set oColl = ThisApplication.TransientObjects.CreateObjectCollection
    
    Dim oDC As DrawingCurve
    
    For Each oDC In oDCurves
    
        Dim oDCSs As DrawingCurveSegments
        Set oDCSs = oDC.Segments
        
        Dim oDCS As DrawingCurveSegment
        
        For Each oDCS In oDCSs
            Call oColl.Add(oDCS)
        Next
        
    Next
    
    Dim oSheet As Inventor.sheet
    Set oSheet = oView.Parent
    
    Dim oDDoc As DrawingDocument
    Set oDDoc = oSheet.Parent
    
    Dim oLayers As Inventor.LayersEnumerator
    Set oLayers = oDDoc.StylesManager.Layers
    
    Dim oLayer As Inventor.Layer
    Set oLayer = oLayers.Item("MyCustomLayer")
    
    If oLayer Is Nothing Then
        oLayer = oLayers.Item(1).Copy("MyCustomLayer")
    End If
        
    Call oView.Parent.ChangeLayer(oColl, oLayer)
    oDDoc.Update2 (True)

GoTo Repeat

End If
    
End Sub