SolidWorks API @ wiki
SolidWorks API @ wiki

表示


再表示

Sub Refresh()
    Dim objApp As SldWorks.SldWorks
    Dim objModelDoc As SldWorks.ModelDoc2
    Dim objModView As SldWorks.ModelView
    Dim rect As Variant
    Set rect = Nothing
    Set objApp = Application.SldWorks
    Set objModelDoc = objApp.ActiveDoc
    Set objModView = objModelDoc.ActiveView
    Call objModView.GraphicsRedraw(rect)
End Sub
 

最大表示

Sub FitView()
    Dim objApp As SldWorks.SldWorks
    Dim objModelDoc As SldWorks.ModelDoc2
    Set objApp = Application.SldWorks
    Set objModelDoc = objApp.ActiveDoc
    Call objModelDoc.ViewZoomtofit2
End Sub
 

回転1

Const PI As Double = 3.14159265358979
Const PI_Radian As Double = 180
 
Function Radian(ByVal Degrees As Double) As Double
    Radian = (PI / PI_Radian) * Degrees
End Function
 
Function Degrees(ByVal Radian As Double) As Double
    Degrees = (PI_Radian / PI) * Radian
End Function
 
Sub ViewRotate1()
    Dim objApp As SldWorks.SldWorks
    Dim objModelDoc As SldWorks.ModelDoc2
    Set objApp = Application.SldWorks
    Set objModelDoc = objApp.ActiveDoc
 
    '矢印キー操作時の回転角度設定
    Call objApp.SetUserPreferenceDoubleValue(swUserPreferenceDoubleValue_e.swViewRotationArrowKeys, Radian(15))
 
    '画面下に向かって回転(矢印キー下と同等)
    objModelDoc.ViewRotateminusx
    '画面左に向かって回転(矢印キー左と同等)
    objModelDoc.ViewRotateminusy
    '画面上を右に回転(ALT+矢印キー左と同等)
    objModelDoc.ViewRotateminusz
    '画面上に向かって回転(矢印キー上と同等)
    objModelDoc.ViewRotateplusx
    '画面右に向かって回転(矢印キー右と同等)
    objModelDoc.ViewRotateplusy
    '画面上を左に回転(ALT+矢印キー右と同等)
    objModelDoc.ViewRotateplusz
    '画面下に向かって90度回転
    objModelDoc.ViewRotXMinusNinety
    '画面上に向かって90度回転
    objModelDoc.ViewRotXPlusNinety
    '画面左に向かって90度回転
    objModelDoc.ViewRotYMinusNinety
    '画面右に向かって90度回転
    objModelDoc.ViewRotYPlusNinety
End Sub
 

回転2

Sub ViewRotate2()
    Dim objApp As SldWorks.SldWorks
    Dim objModelDoc As SldWorks.ModelDoc2
    Dim objModView As SldWorks.ModelView
    Dim OrientationValue As MathTransform
    Dim dblArray() As Double
    Dim dblZenithAngle As Double
    Dim dblAzimuth As Double
    Dim dblZ_DirectionX As Double
    Dim dblZ_DirectionY As Double
    Dim dblZ_DirectionZ As Double
    Dim dblWork As Double
    Dim rect As Variant
    Set rect = Nothing
    Set objApp = Application.SldWorks
    Set objModelDoc = objApp.ActiveDoc
    Set objModView = objModelDoc.ActiveView
    Set OrientationValue = objModView.Orientation3
    dblArray = OrientationValue.ArrayData
 
    '等角投影の設定
    '方位角(Z軸)
    dblAzimuth = -45
    dblWork = Tan(Radian(30))
    '天頂角
    dblZenithAngle = -1 * Degrees(Atn(dblWork / Sqr(-dblWork * dblWork + 1)))
 
    'Z方向(X:右方向=+1 Y:上方向=+1 Z:手前方向=+1)
    dblZ_DirectionX = Sgn(dblAzimuth)
    dblZ_DirectionY = Sgn(dblZenithAngle)
    If dblAzimuth > 90 Or dblAzimuth < -90 Then
        dblZ_DirectionZ = -1
    ElseIf dblAzimuth < 90 And dblAzimuth > -90 Then
        dblZ_DirectionZ = 1
    Else
        dblZ_DirectionZ = 0
    End If
 
    'Z軸角(Z,X,Yの順に設定が優先される)
    dblArray(6) = Sin(Radian(Abs(dblAzimuth))) * dblZ_DirectionX
    dblArray(8) = Sin(Radian(Abs(dblZenithAngle))) * dblZ_DirectionZ
    dblArray(7) = Abs(dblArray(6) * dblArray(8)) * dblZ_DirectionY
    'X軸角
    dblArray(0) = dblArray(6) * -1
    'dblArray(1) = dblArray(7)
    dblArray(1) = 0
    'dblArray(2) = dblArray(8)
    dblArray(2) = 0
    'Y軸角
    dblArray(3) = 0
    dblArray(4) = Cos(Radian((dblZenithAngle)) * dblZ_DirectionY * -1)
    'dblArray(5) = dblArray(8)
    dblArray(5) = 0
 
    OrientationValue.ArrayData = dblArray
    objModView.Orientation3 = OrientationValue
    Call objModelDoc.ViewZoomtofit2
    Call objModView.GraphicsRedraw(rect)
End Sub
 

イメージ品質

Sub ChangeImageQuality()
    Dim objApp As SldWorks.SldWorks
    Dim objModelDoc As SldWorks.ModelDoc2
    Dim objExtension As SldWorks.ModelDocExtension
    Dim dblCurrent As Double
    Dim dblMax As Double
    Dim dblMin As Double
    Dim dblNew As Double
    Dim dblUnit As Double
    Dim intLevel As Integer
    Const intDivisions As Integer = 4
    Set objApp = Application.SldWorks
    Set objModelDoc = objApp.ActiveDoc
    Set objExtension = objModelDoc.Extension
    '現在のイメージ品質取得
    Call objExtension.GetUserPreferenceDoubleValueRange(swUserPreferenceDoubleValue_e.swImageQualityShadedDeviation, dblCurrent, dblMin, dblMax)
    dblUnit = (dblMax - dblMin) / CDbl(intDivisions)
    intLevel = ((dblMax - dblCurrent) / dblUnit) + 1
    intLevel = Val((InputBox("イメージ品質(1～" & (intDivisions + 1) & ")", "イメージ品質設定", intLevel)))
    If intLevel <= 1 Then
        dblNew = dblMax
    ElseIf intLevel > intDivisions Then
        dblNew = dblMin
    Else
        dblNew = dblMax - (dblUnit * (intLevel - 1))
    End If
    'イメージ品質設定
    Call objExtension.SetUserPreferenceDouble(swImageQualityShadedDeviation, swUserPreferenceOption_e.swDetailingNoOptionSpecified, dblNew)
End Sub
 

平面表示切替

アクティブなドキュメントの平面表示を切り換える（アイテムの視認性ではなく、実際の表示・非表示を切り換える） 
Sub ToggleDisplayPlane()
    Dim objApp As SldWorks.SldWorks
    Dim objModelDoc As SldWorks.ModelDoc2
    Dim objExtension As SldWorks.ModelDocExtension
    Dim objFeatureMgr As SldWorks.FeatureManager
    Dim objFeature As SldWorks.Feature
    Dim arrayFeatures As Variant
    Dim varFeature As Variant
    Dim objSelectionMgr As SldWorks.SelectionMgr
    Dim objSelectData As SldWorks.SelectData
    Dim intFirstItemVisible As Integer
    '平面のタイプネーム
    Const swTnRefPlane As String = "RefPlane"
 
    Set objApp = Application.SldWorks
    Set objModelDoc = objApp.ActiveDoc
    Call objModelDoc.ClearSelection2(True)
    Set objExtension = objModelDoc.Extension
    Set objFeatureMgr = objModelDoc.FeatureManager
    Set objSelectionMgr = objModelDoc.SelectionManager
    Set objSelectData = objSelectionMgr.CreateSelectData
 
    arrayFeatures = objFeatureMgr.GetFeatures(True)
    intFirstItemVisible = 0
    For Each varFeature In arrayFeatures
        Set objFeature = varFeature
        If objFeature.GetTypeName2() = swTnRefPlane Then
            If intFirstItemVisible = 0 Then
                intFirstItemVisible = objFeature.Visible
            End If
            Call objSelectionMgr.AddSelectionListObject(objFeature, objSelectData)
        End If
    Next
    If intFirstItemVisible = swVisibilityState_e.swVisibilityStateHide Then
        Call objModelDoc.UnBlankRefGeom
    Else
        Call objModelDoc.BlankRefGeom
    End If
    Call objModelDoc.ClearSelection2(True)
End Sub
 

すべての部品を表示

Sub ShowAllPart()
    Dim objApp As SldWorks.SldWorks
    Dim objModelDoc As SldWorks.ModelDoc2
    Dim objConfMgr As SldWorks.ConfigurationManager
    Dim objConf As SldWorks.Configuration
    Dim objComponent As SldWorks.Component2
    Set objApp = Application.SldWorks
    Set objModelDoc = objApp.ActiveDoc
    Set objConfMgr = objModelDoc.ConfigurationManager
    Set objConf = objConfMgr.ActiveConfiguration
    Set objComponent = objConf.GetRootComponent3(True)
    Call SelectAllComponent(objComponent)
    Call objModelDoc.ShowComponent2
    Call objModelDoc.ClearSelection2(True)
End Sub
 
Sub SelectAllComponent(objAssyComponent As SldWorks.Component2, Optional isApend As Boolean = False, Optional isApendSuppressed As Boolean = False)
    If isApend = False Then
        Dim objApp As SldWorks.SldWorks
        Dim objModelDoc As SldWorks.ModelDoc2
        Set objApp = Application.SldWorks
        Set objModelDoc = objApp.ActiveDoc
        Call objModelDoc.ClearSelection2(True)
    End If
    Dim arrayObjComp As Variant
    Dim objCompVariant As Variant
    Dim objComponent As SldWorks.Component2
    If isApendSuppressed Or (objAssyComponent.IsSuppressed = False) Then
        Call objAssyComponent.Select4(True, Nothing, False)
        arrayObjComp = objAssyComponent.GetChildren()
        For Each objCompVariant In arrayObjComp
            Set objComponent = objCompVariant
            Call SelectAllComponent(objComponent, True, isApendSuppressed)
        Next
    End If
End Sub
 

選択した部品のみ表示

Sub ShowSelectedPartOnly()
    Dim objApp As SldWorks.SldWorks
    Dim objModelDoc As SldWorks.ModelDoc2
    Dim objComponent As SldWorks.Component2
    Dim objSelectionMgr As SldWorks.SelectionMgr
    Dim arraySelectedComponents() As SldWorks.Component2
    Dim i As Integer
    Dim intSelectedCount As Integer
    Dim intComponentCount As Integer
 
    Set objApp = Application.SldWorks
    Set objModelDoc = objApp.ActiveDoc
    Set objSelectionMgr = objModelDoc.SelectionManager
    intComponentCount = 0
    intSelectedCount = objSelectionMgr.GetSelectedObjectCount2(-1)
    If intSelectedCount > 0 Then
        For i = 1 To intSelectedCount
            Set objComponent = objSelectionMgr.GetSelectedObjectsComponent3(i, -1)
            If Not (objComponent Is Nothing) Then
                intComponentCount = intComponentCount + 1
                ReDim Preserve arraySelectedComponents(1 To intComponentCount)
                Set arraySelectedComponents(intComponentCount) = objComponent
            End If
        Next
        If intComponentCount > 0 Then
            Call objModelDoc.Extension.SelectAll
            Call objModelDoc.HideComponent2
            Call objModelDoc.ClearSelection2(True)
            For i = 1 To intComponentCount
                Call SelectAllComponent(arraySelectedComponents(i), True)
            Next
            Call objModelDoc.ShowComponent2
            Call objModelDoc.ClearSelection2(True)
        End If
    End If
End Sub
 
 
Sub SelectAllComponent(objAssyComponent As SldWorks.Component2, Optional isApend As Boolean = False, Optional isApendSuppressed As Boolean = False)
    If isApend = False Then
        Dim objApp As SldWorks.SldWorks
        Dim objModelDoc As SldWorks.ModelDoc2
        Set objApp = Application.SldWorks
        Set objModelDoc = objApp.ActiveDoc
        Call objModelDoc.ClearSelection2(True)
    End If
    Dim arrayObjComp As Variant
    Dim objCompVariant As Variant
    Dim objComponent As SldWorks.Component2
    If isApendSuppressed Or (objAssyComponent.IsSuppressed = False) Then
        Call objAssyComponent.Select4(True, Nothing, False)
        arrayObjComp = objAssyComponent.GetChildren()
        For Each objCompVariant In arrayObjComp
            Set objComponent = objCompVariant
            Call SelectAllComponent(objComponent, True, isApendSuppressed)
        Next
    End If
End Sub
 



コメント

「表示」をウィキ内検索
最終更新：2013年12月17日 00:10