How to change line color/thickness of a selected edge in a drawing with a macro

[berg_lauritz]

Crosspost from here, so there are google search results:

I was trying to quickly make a macro, that colors a selected edge on a drawing & adds a custom line thickness to it, but I cannot get it to run, because it fails at swThisEdge.SetLineColor 255 - telling me, that this object does not support this property or method.
What am I doing wrong?

Code: Select all

Dim swApp As SldWorks.SldWorks

Sub main()

    Set swApp = Application.SldWorks
    
    Dim swModel As SldWorks.ModelDoc2
    
    Set swModel = swApp.ActiveDoc

If Not swModel Is Nothing Then
    
    Dim swSelMgr As SldWorks.SelectionMgr
    Dim i As Integer
        
    Set swSelMgr = swModel.SelectionManager
      
        If swSelMgr.GetSelectedObjectCount2(-1) > 0 Then
            For i = 1 To swSelMgr.GetSelectedObjectCount2(-1)
                Debug.Print swSelMgr.GetSelectedObjectType3(i, -1)
                If swSelMgr.GetSelectedObjectType3(i, -1) = swSelectType_e.swSelEDGES Then
                    Dim swThisEdge As Object
                    Set swThisEdge = swSelMgr.GetSelectedObject6(i, -1)
                    swThisEdge.SetLineColor 255
                    swThisEdge.SetLineWidthCustom (0.0007)
                End If
            Next

        Else
            MsgBox "Please select an edge!"
        End If
        
       
    Else
        MsgBox "Open model and select edge!"
    End If

Solution:

The code below will do the magic. The error tells you exacly whats is wrong. You're calling SetLineColor on a SldWorks.Edge whicht doesn't have the method SetLineColor, this is a method of SldWorks.DrawingDoc.

Code: Select all

Option Explicit

Sub main()
    
    Dim swApp As SldWorks.SldWorks
    Set swApp = Application.SldWorks
    
    Dim swModel As SldWorks.ModelDoc2
    Set swModel = swApp.ActiveDoc
    
    If swModel Is Nothing Then Exit Sub

    If swModel.GetType <> swDocDRAWING Then Exit Sub

    Dim swDrw As SldWorks.DrawingDoc
    Set swDrw = swModel
    
    swDrw.SetLineColor RGB(255, 0, 0)
    swDrw.SetLineWidthCustom 0.0007
 
End Sub

[berg_lauritz]

Here is my revised code:

Code: Select all

Option Explicit


Sub main()

    Dim swApp As SldWorks.SldWorks
    Set swApp = Application.SldWorks
    
    Dim swModel As SldWorks.ModelDoc2
    Set swModel = swApp.ActiveDoc
    
        If Not swModel Is Nothing Then
'            Debug.Print swModel.GetType
            If swModel.GetType = swDocDRAWING Then
'                Debug.Print "This is a DRAWING!"
                Dim swDraw As SldWorks.DrawingDoc
                Set swDraw = swModel
                Dim swSelMgr As SldWorks.SelectionMgr
                Set swSelMgr = swModel.SelectionManager

                If swSelMgr.GetSelectedObjectCount2(-1) > 0 Then
'                    Debug.Print swSelMgr.GetSelectedObjectCount2(-1)
                    Dim edgeWidth As Double
                    Dim edgeColor As Integer
                    edgeWidth = 0.0007
                    edgeColor = 255

                    swDraw.SetLineWidthCustom (edgeWidth)
                    swDraw.SetLineColor edgeColor
                Else
                    MsgBox "Please select an edge!"
                End If
            Else
                MsgBox "You need to open a DRAWING and select an edge!"
            End If
        Else
            MsgBox "Please open a drawing and select an edge!"
        End If

End Sub