Dimension color macro 1

[smcadman]

I haven't found a particular thread on this, but there are some that are close. We purchased a couple of Konica Minolta Bizhub C250'S color laser printers and now print dimensions on one layer. BOM's, notes, balloons on another layer.

From "Macro for layer color change?" thread

http://www.eng-tips.com/viewthread.cfm?qid=166199&page=2

I know the colors for the 2 layers.

I also read "How to find OVERRIDE Dimensions in a drawing?"

http://www.eng-tips.com/viewthread.cfm?qid=165835&page=1

Which gave me the idea for this macro.

Objective[ul]
[li]Automatically find dimensions and place them on existing "Dims" layer.[/li]
[li]Automatically find BOM's, Leaders, Notes and place them on existing "Text layer.[/li]
[/ul]

2 existing layers:
Dims layer color = 771752142
text layer color = 10944512

If BOM's, notes, baloons would be too much trouble, I would settle for help on just getting the dims on there own layer.

SW06 SP5.0


Flores

 

[handleman]

The color override macro iterates through all the display dimensions in a drawing. However, dimensions are just a type of annotation. You can iterate through all the annotations in almost the exact same manner. The types of annotations are:

swCThread

swDatumTag

swDatumTargetSym

swDisplayDimension

swGTol

swNote

swSFSymbol

swWeldSymbol

swCustomSymbol

swDowelSym

swLeader

swCenterMarkSym

swCenterLine

swDatumOrigin

swWeldBeadSymbol

Which annotations to you want moved to which layers? I assume swDisplayDimension goes to the "Dims" layer, but I'm guessing you don't want every one of these anotations on the "Text" layer.

 

[handleman]

Oops, looks like my help file's not up to date. Here is the full list of annotation types (alphabetical, not numerical order!):

swBlock
swCenterLine
swCenterMarkSym
swCThread
swCustomSymbol
swDatumOrigin
swDatumTag
swDatumTargetSym
swDisplayDimension
swDowelSym
swGTol
swLeader
swNote
swSFSymbol
swTableAnnotation
swWeldBeadSymbol
swWeldSymbol

You should be able to add/switch etc these to the code below:

Const COLORQUERY As Boolean = False
Const TEXTLAYERCOLOR As Long = 10944512
Const DIMSLAYERCOLOR As Long = 771752142

Dim swApp As SldWorks.SldWorks
Dim swDoc As SldWorks.ModelDoc2
Dim swDwg As SldWorks.DrawingDoc
Dim swView As SldWorks.View
Dim swAnnot As SldWorks.Annotation
Dim sMsg As String
Dim swLyrMgr As SldWorks.LayerMgr
Dim swLayer As SldWorks.Layer


Sub MoveDimsAndTablesToLayers()

Set swApp = Application.SldWorks
Set swDoc = swApp.ActiveDoc

If swDoc.GetType <> swDocDRAWING Then
    MsgBox "This macro only works for drawing files."
    Exit Sub
End If

Set swDwg = swDoc

Set swLyrMgr = swDoc.GetLayerManager

If COLORQUERY Then
    Set swLayer = swLyrMgr.GetLayer(swLyrMgr.GetCurrentLayer)
    MsgBox "The color of layer " & swLayer.Name & " is " & swLayer.Color
    Exit Sub
End If

Set swLayer = swLyrMgr.GetLayer("Text")
swLayer.Color = TEXTLAYERCOLOR
Set swLayer = swLyrMgr.GetLayer("Dims")
swLayer.Color = DIMSLAYERCOLOR

Set swView = swDwg.GetFirstView
While Not (swView Is Nothing)
    Set swAnnot = swView.GetFirstAnnotation3
    While Not swAnnot Is Nothing
        If swAnnot.GetType = swDisplayDimension Then
            swAnnot.Layer = "Dims"
        ElseIf swAnnot.GetType = swNote Then
            swAnnot.Layer = "Text"
        ElseIf swAnnot.GetType = swTableAnnotation Then
            swAnnot.Layer = "Text"
        End If
        Set swAnnot = swAnnot.GetNext3
    Wend
    Set swView = swView.GetNextView
Wend

Set swLayer = Nothing
Set swLyrMgr = Nothing
Set swAnnot = Nothing
Set swView = Nothing
Set swDwg = Nothing
Set swDoc = Nothing
Set swApp = Nothing

End Sub

 

[smcadman]

Thanks handleman! That worked like a charm.

SW06 SP5.0

Flores

 

[smcadman]

handleman, I hope I'm not being greedy, but I have 1 more request. We have some text "-NOT FOR PRODUCTION-" on a layer called "Not for Production" that we have on our drawing templates. We keep this layer visible while our projects are in the prototype stage. After all tweaks are made and a purchase order is cut, then we turn the "Not for Production" layer off.

Is there anyway to either skip this layer or skip that text?

SW06 SP5.0

Flores

 

[CorBlimeyLimey]

Make the "Not for Production" a block.

​

Helpful SW websites faq559-520​

How to find answers ... faq559-1091​

SW2006-SP5 Basic ... No PDM​

 

[handleman]

Sure... just add another "If" block to check the current layer of the active annotation. Like so:

Const COLORQUERY As Boolean = False
Const TEXTLAYERCOLOR As Long = 10944512
Const DIMSLAYERCOLOR As Long = 771752142

Dim swApp As SldWorks.SldWorks
Dim swDoc As SldWorks.ModelDoc2
Dim swDwg As SldWorks.DrawingDoc
Dim swView As SldWorks.View
Dim swAnnot As SldWorks.Annotation
Dim sMsg As String
Dim swLyrMgr As SldWorks.LayerMgr
Dim swLayer As SldWorks.Layer


Sub MoveDimsAndTablesToLayers()

Set swApp = Application.SldWorks
Set swDoc = swApp.ActiveDoc

If swDoc.GetType <> swDocDRAWING Then
    MsgBox "This macro only works for drawing files."
    Exit Sub
End If

Set swDwg = swDoc

Set swLyrMgr = swDoc.GetLayerManager

If COLORQUERY Then
    Set swLayer = swLyrMgr.GetLayer(swLyrMgr.GetCurrentLayer)
    MsgBox "The color of layer " & swLayer.Name & " is " & swLayer.Color
    Exit Sub
End If

Set swLayer = swLyrMgr.GetLayer("Text")
swLayer.Color = TEXTLAYERCOLOR
Set swLayer = swLyrMgr.GetLayer("Dims")
swLayer.Color = DIMSLAYERCOLOR

Set swView = swDwg.GetFirstView
While Not (swView Is Nothing)
    Set swAnnot = swView.GetFirstAnnotation3
    While Not swAnnot Is Nothing
        If swAnnot.Layer = "Not For Production" Then
            'Skip this annotation
        ElseIf swAnnot.GetType = swDisplayDimension Then
            swAnnot.Layer = "Dims"
        ElseIf swAnnot.GetType = swNote Then
            swAnnot.Layer = "Text"
        ElseIf swAnnot.GetType = swTableAnnotation Then
            swAnnot.Layer = "Text"
        End If
        Set swAnnot = swAnnot.GetNext3
    Wend
    Set swView = swView.GetNextView
Wend

Set swLayer = Nothing
Set swLyrMgr = Nothing
Set swAnnot = Nothing
Set swView = Nothing
Set swDwg = Nothing
Set swDoc = Nothing
Set swApp = Nothing

End Sub

 

[smcadman]

CBL, that worked, but our older drawings already have the "Not for Production" layer on them and by improving this macro, adding the block will not be required.

handleman, for some odd reason the text for "-NOT FOR PRODUCTION-" was still put on the text layer and turned to the text layer color. I fiddled with it and added:

Const PRODUCTIONLAYERCOLOR As Long = 771752142

and

Set swLayer = swLyrMgr.GetLayer("Not for Production")
swLayer.Color = PRODUCTIONLAYERCOLOR
and it is working now.

Const COLORQUERY As Boolean = False
Const TEXTLAYERCOLOR As Long = 10944512
Const DIMSLAYERCOLOR As Long = 771752142
Const PRODUCTIONLAYERCOLOR As Long = 771752142

Dim swApp As SldWorks.SldWorks
Dim swDoc As SldWorks.ModelDoc2
Dim swDwg As SldWorks.DrawingDoc
Dim swView As SldWorks.View
Dim swAnnot As SldWorks.Annotation
Dim sMsg As String
Dim swLyrMgr As SldWorks.LayerMgr
Dim swLayer As SldWorks.Layer


Sub MoveDimsAndTablesToLayers()

Set swApp = Application.SldWorks
Set swDoc = swApp.ActiveDoc

If swDoc.GetType <> swDocDRAWING Then
    MsgBox "This macro only works for drawing files."
    Exit Sub
End If

Set swDwg = swDoc

Set swLyrMgr = swDoc.GetLayerManager

If COLORQUERY Then
    Set swLayer = swLyrMgr.GetLayer(swLyrMgr.GetCurrentLayer)
    MsgBox "The color of layer " & swLayer.Name & " is " & swLayer.Color
    Exit Sub
End If

Set swLayer = swLyrMgr.GetLayer("Text")
swLayer.Color = TEXTLAYERCOLOR
Set swLayer = swLyrMgr.GetLayer("Dims")
swLayer.Color = DIMSLAYERCOLOR
Set swLayer = swLyrMgr.GetLayer("Not for Production")
swLayer.Color = PRODUCTIONLAYERCOLOR

Set swView = swDwg.GetFirstView
While Not (swView Is Nothing)
    Set swAnnot = swView.GetFirstAnnotation3
    While Not swAnnot Is Nothing
        If swAnnot.Layer = "Not for Production" Then
            'Skip this annotation
        ElseIf swAnnot.GetType = swDisplayDimension Then
            swAnnot.Layer = "Dims"
        ElseIf swAnnot.GetType = swNote Then
            swAnnot.Layer = "Text"
        ElseIf swAnnot.GetType = swTableAnnotation Then
            swAnnot.Layer = "Text"
        End If
        Set swAnnot = swAnnot.GetNext3
    Wend
    Set swView = swView.GetNextView
Wend

Set swLayer = Nothing
Set swLyrMgr = Nothing
Set swAnnot = Nothing
Set swView = Nothing
Set swDwg = Nothing
Set swDoc = Nothing
Set swApp = Nothing

End Sub

SW06 SP5.0

Flores