ソリッドワークの床の影をマクロでレンダリングする

Question

レンダリングを実行して自動的にそれらを保存するマクロを開発しようとしています。ファイル（パスあり）が一覧表示され、Excelファイルから抽出され、開いてレンダリングされます。 この部分はうまくいきましたが、今はVBAコード内の床の陰影（および床の反射）を取り除きたいと思います。ランダムなSolidWorksファイルで床の陰影を消しながらマクロを記録しようとしましたが、残念ながらこの部分は記録されません。 誰にでもこれに対する解決策がありますか？事前に

感謝のSolidWorksチュートリアルで

' 

****************************************************************************** 
' C:\Users\Omar\AppData\Local\Temp\swx11684\Macro1.swb - macro recorded on 11/25/16 by Omar 
' ****************************************************************************** 

Sub main() 
Dim swApp As Object 
Dim Part As Object 
Dim boolstatus As Boolean 
Dim longstatus As Long, longwarnings As Long 
Dim status As Boolean 
Set swApp = Application.SldWorks 
Dim i As String 
Dim j As String 
Dim y As Integer 
Dim z As String 
Dim n As Integer 
Dim m As Integer 
Dim swModel As SldWorks.ModelDoc2 
Dim swRayTraceRenderer As SldWorks.RayTraceRenderer 
Dim swRayTraceRenderOptions As SldWorks.RayTraceRendererOptions 
Dim errors As Long 
Dim warnings As Long 
Dim filePath As String 
Dim Scene As SldWorks.SWScene 
Dim swConfig As SldWorks.Configuration 
Dim swPoint As SldWorks.MathPoint 
Dim point As Variant 
Dim swVector As SldWorks.MathVector 
Dim vect As Variant 


'Dim xlApp As Object, xlWB As Object 
'Set xlApp = CreateObject("Excel.Application") 

'i = file name 
'j = file extention 

'i = "bp01p0006" example 
'j = "simbeton - Solidworks\bp - betonplaten\bp01 - simvlak\" example 

'Set xlWB = xlApp.Workbooks.Open(“C:\Users\Omar\Desktop\Renders Rob\Lijst.xlsx”) 


y = 0 


n = 0 

Do While n < 5 
Dim xlApp As Excel.Application 
Dim xlWB As Excel.Workbook 
Set xlApp = New Excel.Application 
Set xlWB = xlApp.Workbooks.Open("C:\Users\Omar\Desktop\Renders Rob\Lijst.xlsx") 
    If xlWB.Worksheets(1).Range("A1").offset(y, 0) = "" Then 
     y = y + 1 
     n = n + 1 
     Else 
      j = xlWB.Worksheets(1).Range("A1").offset(y, 0).value 
      i = xlWB.Worksheets(1).Range("A1").offset(y, 1).value 
      z = xlWB.Worksheets(1).Range("A1").offset(y, 2).value 
      xlWB.Worksheets(1).Range("A1").offset(y, 0) = "" 
      y = y + 1 
    End If 

Set xlWB = Nothing 
Set xlApp = Nothing 

filePath = "" & j & "\" & i & ".SLDPRT" 
Set swModel = swApp.OpenDoc6(filePath, swDocPART, swOpenDocOptions_Silent, "", errors, warnings) 

Set Part = swApp.ActiveDoc 

Set swApp = _ 
Application.SldWorks 

Dim myModelView As Object 
Set myModelView = Part.ActiveView 
myModelView.AddPerspective 
Part.ViewZoomtofit2 
Part.ViewZoomtofit2 
Part.ViewZoomtofit2 
Part.ViewZoomtofit2 
Part.ViewZoomtofit2 
Part.ShowNamedView2 "*Isometric", 7 
Part.ViewZoomtofit2 

Part.ViewDisplayShaded 
Dim activeModelView As Object 
Set activeModelView = Part.ActiveView 
activeModelView.DisplayMode = swViewDisplayMode_e.swViewDisplayMode_ShadedWithEdges 
Part.ClearSelection2 True 
boolstatus = Part.Extension.SketchBoxSelect("0.000000", "0.000000", "0.000000", "0.000000", "0.000000", "0.000000") 
Part.ViewDisplayShaded 

' Access PhotoView 360 
Set swRayTraceRenderer = swApp.GetRayTraceRenderer(swPhotoView) 
' Get and set rendering options 
Set swRayTraceRenderOptions = swRayTraceRenderer.RayTraceRendererOptions 
'Get current rendering values 
Debug.Print "Current rendering values" 
Debug.Print " ImageHeight   = " & swRayTraceRenderOptions.ImageHeight 
Debug.Print " ImageWidth   = " & swRayTraceRenderOptions.ImageWidth 
Debug.Print " ImageFormat   = " & swRayTraceRenderOptions.ImageFormat 
Debug.Print " PreviewRenderQuality = " & swRayTraceRenderOptions.PreviewRenderQuality 
Debug.Print " FinalRenderQuality = " & swRayTraceRenderOptions.FinalRenderQuality 
Debug.Print " BloomEnabled   = " & swRayTraceRenderOptions.BloomEnabled 
Debug.Print " BloomThreshold  = " & swRayTraceRenderOptions.BloomThreshold 
Debug.Print " BloomRadius   = " & swRayTraceRenderOptions.BloomRadius 
Debug.Print " ContourEnabled  = " & swRayTraceRenderOptions.ContourEnabled 
Debug.Print " ShadedContour  = " & swRayTraceRenderOptions.ShadedContour 
Debug.Print " ContourLineThickness = " & swRayTraceRenderOptions.ContourLineThickness 
Debug.Print " ContourLineColor  = " & swRayTraceRenderOptions.ContourLineColor 
Debug.Print " " 
'Change rendering values 
Debug.Print "New rendering values" 
swRayTraceRenderOptions.ImageHeight = 405 
Debug.Print " ImageHeight   = " & swRayTraceRenderOptions.ImageHeight 
swRayTraceRenderOptions.ImageWidth = 720 
Debug.Print " ImageWidth   = " & swRayTraceRenderOptions.ImageWidth 
swRayTraceRenderOptions.ImageFormat = swImageFormat_PNG 
Debug.Print " ImageFormat   = " & swRayTraceRenderOptions.ImageFormat 
swRayTraceRenderOptions.PreviewRenderQuality = swRenderQuality_Better 
Debug.Print " PreviewRenderQuality = " & swRayTraceRenderOptions.PreviewRenderQuality 
swRayTraceRenderOptions.FinalRenderQuality = swRenderQuality_Best 
Debug.Print " FinalRenderQuality = " & swRayTraceRenderOptions.FinalRenderQuality 
swRayTraceRenderOptions.BloomEnabled = False 
Debug.Print " BloomEnabled   = " & swRayTraceRenderOptions.BloomEnabled 
swRayTraceRenderOptions.BloomThreshold = 0 
Debug.Print " BloomThreshold  = " & swRayTraceRenderOptions.BloomThreshold 
swRayTraceRenderOptions.BloomRadius = 0 
Debug.Print " BloomRadius   = " & swRayTraceRenderOptions.BloomRadius 
swRayTraceRenderOptions.ContourEnabled = False 
Debug.Print " ContourEnabled  = " & swRayTraceRenderOptions.ContourEnabled 
swRayTraceRenderOptions.ShadedContour = False 
Debug.Print " ShadedContour  = " & swRayTraceRenderOptions.ShadedContour 
swRayTraceRenderOptions.ContourLineThickness = 0 
Debug.Print " ContourLineThickness = " & swRayTraceRenderOptions.ContourLineThickness 
swRayTraceRenderOptions.ContourLineColor = 255 
Debug.Print " ContourLineColor  = " & swRayTraceRenderOptions.ContourLineColor 
' Display the preview window 
status = swRayTraceRenderer.DisplayPreviewWindow 
' Close render 
status = swRayTraceRenderer.CloseRayTraceRender 
' Invoke final render window 
status = swRayTraceRenderer.InvokeFinalRender 
' Abort final render window 
status = swRayTraceRenderer.AbortFinalRender 
' Render to Windows Bitmap format 
status = swRayTraceRenderer.RenderToFile("C:\Users\Omar\Desktop\Renders Rob\" & i & z & ".png", 0, 0) 
swRayTraceRenderOptions.FinalRenderQuality = swRenderQuality_Good 
' Render to HDR format (format extension omitted) 
status = swRayTraceRenderer.RenderToFile("C:\Users\Omar\Desktop\Renders Rob\" & i & z, 0, 0) 
Set swRayTraceRenderOptions = Nothing 
' Close render 
status = swRayTraceRenderer.CloseRayTraceRender 

swApp.QuitDoc i 

Loop 

End Sub 

Answer 1

：FloorShadowsプロパティ（ISwScene）

Option Explicit 
    Dim Scene As SldWorks.SWScene 
    Dim swApp As SldWorks.SldWorks 
    Dim swModel As SldWorks.ModelDoc2 
    Dim swConfig As SldWorks.Configuration 
    Dim swPoint As SldWorks.MathPoint 
    Dim swVector As SldWorks.MathVector 
    Dim point As Variant 
    Dim vect As Variant 

    Sub main() 

     Set swApp = Application.SldWorks 
     Set swModel = swApp.ActiveDoc 

     Set swConfig = swModel.GetActiveConfiguration 
     Debug.Print "Configuration: " & swConfig.Name 

     Set Scene = swConfig.GetScene 

     Dim P2SFilename As String 
     Scene.GetP2SFileName P2SFilename 
     Debug.Print "Scene file: " & P2SFilename 

     Scene.GetFloorNormal swPoint, swVector 
     point = swPoint.ArrayData 
     Debug.Print "Scene floor normal point: " & point(0) & ", " & point(1) & ", " & point(2) 
     vect = swVector.ArrayData 
     Debug.Print "Scene floor normal vector: " & vect(0) & ", " & vect(1) & ", " & vect(2) 

     Dim value As Boolean 
     Scene.FloorShadows = False '<- Here ! 
     value = Scene.FloorShadows 'debug 

     Scene.BackgroundType = swSceneBackgroundType_e.swBackgroundType_UseEnvironment 
     Debug.Print "Type of scene background as defined in swSceneBackgroundType_e: " & Scene.BackgroundType 
     Debug.Print "Scene background environment image file: " & Scene.BackgroundEnvImage 
     Debug.Print "Scene background image file: " & Scene.BackgroundImage 
     Debug.Print "Scene environment rotation: " & Scene.EnvironmentRotation 
     Scene.FitToSWWindow = True 
     Debug.Print "Stretch to fit in SOLIDWORKS window? " & Scene.FitToSWWindow 
     Debug.Print "Scale the scene floor uniformly? " & Scene.FixedAspectRatio 
     Debug.Print "Flip the scene floor direction? " & Scene.FloorDirection 
     Debug.Print "Automatically resize the scene floor based on the model bounding box? " & Scene.FloorAutoSize 
     Debug.Print "Distance between scene floor and model: " & Scene.FloorOffset 
     Debug.Print "Flip the scene floor offset direction? " & Scene.FloorOffsetDirection 
     Scene.FloorReflections = True 
     Debug.Print "Show model reflections on the scene floor? " & Scene.FloorReflections 
     Debug.Print "Scene floor rotation: " & Scene.FloorRotation 
     Debug.Print "Show model shadows on the scene floor? " & Scene.FloorShadows 
     Debug.Print "Keep the scene background when changing the scene? " & Scene.KeepBackground 
     Scene.FlattenFloor = True 
     Debug.Print "Flatten the scene floor of the spherical environment? " & Scene.FlattenFloor 
     Debug.Print "Horizon height: " & Scene.HorizonHeight 
     Debug.Print "Environment size: " & Scene.EnvironmentSize 

    End Sub