11-19-2018
01:30 AM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
11-19-2018
01:30 AM
@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
