CAD Forum

Code: Select all

Option Explicit
Sub main()
 
    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim swModelDocExt As SldWorks.ModelDocExtension
 
    ' Get SolidWorks Application
    Set swApp = Application.SldWorks
    ' Get active model document
    Set swModel = swApp.ActiveDoc
 
    ' Check for active document and if document is a Assembly or Part
    If swModel Is Nothing Then End
    If swModel.GetType <> swDocASSEMBLY And swModel.GetType <> swDocPART Then End
    Set swModelDocExt = swModel.Extension
 
    ' Delete current lights
    DeleleteLights swModel

    ' Add a directional light source
    SetAmbiantLightSource swModel, True, RGB(255, 255, 255), 0.3
    AddDirectionalLight swModel, "Directional1", True, RGB(255, 255, 255), 0.1, 0.3, 0.3, True, 90, 45
    AddDirectionalLight swModel, "Directional2", True, RGB(255, 255, 255), 0, 0.1, 0.3, True, -154.41, 37.77
    AddDirectionalLight swModel, "Directional3", True, RGB(255, 255, 255), 0, 0.2, 0.3, True, -101.07, 19.94
 
    ' Rebuild model to show light
    swModelDocExt.EditRebuildAll
 
End Sub

Function DeleleteLights(swModel As SldWorks.ModelDoc2)
    Dim i As Integer
    For i = swModel.GetLightSourceCount - 1 To 0 Step -1
        swModel.DeleteLightSource i
    Next i
End Function

Function AddDirectionalLight( _
    swModel As SldWorks.ModelDoc2, _
    LightName As String, _
    OnInSolidWorks As Boolean, _
    Color As Long, _
    Ambient As Double, _
    Brightness As Double, _
    Specularity As Double, _
    LockToModel As Boolean, _
    Longitude As Double, _
    Latitude As Double _
    )
    Dim X As Double, Y As Double, Z As Double
                             
    GetCartesianCoordinates Longitude, Latitude, X, Y, Z
 
    swModel.AddLightSource LightName, 4, LightName
    swModel.SetLightSourcePropertyValuesVB LightName, 4, Brightness, Color, 1, X, Y, Z, 0, 0, 0, 0, 0, 0, 0, Ambient, Specularity, 0, Not OnInSolidWorks
    swModel.LockLightToModel swModel.GetLightSourceCount - 1, LockToModel

End Function

Function GetCartesianCoordinates(ByVal Longitude As Double, ByVal Latitude As Double, ByRef X As Double, ByRef Y As Double, ByRef Z As Double)
    Longitude = (Longitude * (3.14159265359 / 180))
    Latitude = (Latitude * (3.14159265359 / 180))
    X = Cos(Latitude) * Sin(Longitude)
    Z = Cos(Latitude) * Cos(Longitude)
    Y = Sin(Latitude)
End Function

Function SetAmbiantLightSource(swModel As SldWorks.ModelDoc2, OnInSolidWorks As Boolean, Color As Long, Ambient As Double)
    swModel.SetLightSourcePropertyValuesVB swModel.GetLightSourceName(0), 1, 0, Color, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, Ambient, 0, 0, Not OnInSolidWorks
End Function