Announcements
Attention for Customers without Multi-Factor Authentication or Single Sign-On - OTP Verification rolls out April 2025. Read all about it here.
chandra.shekar.g
in reply to: Anonymous

@Anonymous,

 

Try this.

Sub Main()
    Dim oDoc As DrawingDocument
    oDoc = ThisApplication.ActiveDocument
    
    Dim oSheet As Sheet
    oSheet = oDoc.ActiveSheet
    
    Dim layers As LayersEnumerator
    layers = oDoc.StylesManager.Layers
    
    On Error Resume Next
    Dim oRed As Layer
    oRed = layers.Item("Red")
     
    If Err.Number <> 0 Then
        On Error GoTo 0
        
        Dim redColor As Color
        redColor = ThisApplication.TransientObjects.CreateColor(255, 0, 0)
    
        ' Copy an arbitrary layer giving it the name
        ' of the render style.
        oRed = layers.Item(1).Copy("Red")
    
        ' the attributes of the layer to use the color,
        ' have a solid line type, and a specific width.
        oRed.Color = redColor
        oRed.LineType = kContinuousLineType
        oRed.LineWeight = 0.02
     End If
     
     On Error Resume Next
    Dim oGreen As Layer
    oGreen = layers.Item("Green")
     
    If Err.Number <> 0 Then
        On Error GoTo 0
        
        Dim greenColor As Color
        greenColor = ThisApplication.TransientObjects.CreateColor(0, 255, 0)
    
        ' Copy an arbitrary layer giving it the name
        ' of the render style.
        oGreen = layers.Item(1).Copy("Green")
    
        ' the attributes of the layer to use the color,
        ' have a solid line type, and a specific width.
        oGreen.Color = greenColor
        oGreen.LineType = kContinuousLineType
        oGreen.LineWeight = 0.02
     End If
     
     On Error Resume Next
    Dim oBlue As Layer
    oBlue = layers.Item("Blue")
     
    If Err.Number <> 0 Then
        On Error GoTo 0
        
        Dim blueColor As Color
        blueColor = ThisApplication.TransientObjects.CreateColor(0, 0, 255)
    
        ' Copy an arbitrary layer giving it the name
        ' of the render style.
        oBlue = layers.Item(1).Copy("Blue")
    
        ' the attributes of the layer to use the color,
        ' have a solid line type, and a specific width.
        oBlue.Color = blueColor
        oBlue.LineType = kContinuousLineType
        oBlue.LineWeight = 0.02
     End If 
	 
    Dim oView As DrawingView
    For Each oView In oSheet.DrawingViews
        Dim oReferDoc As AssemblyDocument
        oReferDoc = oView.ReferencedDocumentDescriptor.ReferencedDocument
        
        Dim oAssyDef As AssemblyComponentDefinition
        oAssyDef = oReferDoc.ComponentDefinition 
         
    	Dim occ As ComponentOccurrence
    	For Each occ In oAssyDef.Occurrences         
	        Dim oCurves As DrawingCurvesEnumerator
	        oCurves = oView.DrawingCurves(occ)
	        
	        Dim oCurve As DrawingCurve
	        For Each oCurve In oCurves
	            Dim oColl As ObjectCollection
	            oColl = ThisApplication.TransientObjects.CreateObjectCollection
	            Dim oSegment As DrawingCurveSegment
	            For Each oSegment In oCurve.Segments
	                Call oColl.Add(oSegment)
	            Next
				
				Dim occName As String 
				occName = occ.Name 
				If occName.StartsWith("Element 01") = True Then
					Call oSheet.ChangeLayer(oColl, oRed)
				Else If occName.StartsWith("Element 02") = True Then
					Call oSheet.ChangeLayer(oColl, oGreen)
				Else If occName.StartsWith("Element 04") = True Then
					Call oSheet.ChangeLayer(oColl, oBlue)
				End If 
	            
	            Call oDoc.Update
	        Next 
        
    	Next         
    Next
End Sub

Thanks and regards,


CHANDRA SHEKAR G
Developer Advocate
Autodesk Developer Network