Change Dimension Example (VBA) - 작업중

□ 소개

 

▷ Solidworks connection code

Public swApp As SldWorks.SldWorks
Public swModel As ModelDoc2
Public Sub SolidworksStart()
    On Error Resume Next
    '// Setting up SolidWorks application objects
    Set swApp = GetObject(, "SldWorks.Application")

    On Error GoTo 0
    If swApp Is Nothing Then
        MsgBox "Make sure SolidWorks is running.", vbCritical
        Exit Sub
    End If

    '// Get currently active document
    Set swModel = swApp.ActiveDoc
    If swModel Is Nothing Then
        MsgBox "There are no active SolidWorks documents.", vbCritical
        Exit Sub
    End If

End Sub

 

▷ Get dimension name and dimension value from Part

Option Explicit
Private swFeat As SldWorks.Feature
Private swDim As SldWorks.Dimension
Private WS As Worksheet
Private swDispDim As SldWorks.DisplayDimension
Dim rowIndex As Long
Dim dimIndex As Long
Sub ExportToExcel()
    On Error Resume Next
    Call SolidworksStart.SolidworksStart
    Set WS = ThisWorkbook.Worksheets("Model01")
    On Error GoTo 0
    '// Display model name
    WS.Cells(8, "C").value = swModel.GetTitle
    rowIndex = 10 '// The row where the data starts
    Set swFeat = swModel.FirstFeature
  
    Do While Not swFeat Is Nothing

        dimIndex = 0
        Set swDispDim = swFeat.GetFirstDisplayDimension()

        '// Show only if the feature has dimensions
        If Not swDispDim Is Nothing Then
            
            Do While Not swDispDim Is Nothing
                Set swDim = swDispDim.GetDimension()
                If Not swDim Is Nothing Then
                    WS.Cells(rowIndex, "A").value = rowIndex - 9
                    WS.Cells(rowIndex, "B").value = swFeat.Name
                    WS.Cells(rowIndex, "C").value = swFeat.GetTypeName2()
                    WS.Cells(rowIndex, "D").value = swFeat.GetID()
                    WS.Cells(rowIndex, "E").value = swDim.FullName
                    WS.Cells(rowIndex, "F").value = swDim.value
                    rowIndex = rowIndex + 1
                    dimIndex = dimIndex + 1
                End If
                Set swDispDim = swFeat.GetNextDisplayDimension(swDispDim)
            Loop
        End If
        Set swFeat = swFeat.GetNextFeature
    Loop

    MsgBox "SOLIDWORKS model data has been exported to Excel..", vbInformation
End Sub


'// Get the dimension values of a feature
Function GetFeatureDimensions(feat As SldWorks.Feature) As String
    Dim dimString As String
    dimString = ""

    '// Check the internal dimensions of the feature
    Set swDispDim = feat.GetFirstDisplayDimension()
    Do While Not swDispDim Is Nothing
        Set swDim = swDispDim.GetDimension()
        If Not swDim Is Nothing Then
            If dimString <> "" Then dimString = dimString & "; "
            dimString = dimString & swDim.FullName & "=" & swDim.value
        End If
        Set swDispDim = feat.GetNextDisplayDimension(swDispDim)
    Loop

    GetFeatureDimensions = dimString
End Function

 

이미지 저장

 

 

 

참고 자료

Change Dimension Example (VBA) - 2024 - SOLIDWORKS API Help

 

기본 기능 코드 Code

Sub ChangeDimensionValue()
    '//SolidWorks 앱 객체 가져오기
    Dim swApp As SldWorks.SldWorks
    Dim swModel As ModelDoc2
    Dim swFeat As Feature
    Dim swDim As Dimension

    ' SolidWorks 애플리케이션 객체 설정
    Set swApp = Application.SldWorks

    ' 활성화된 문서를 가져옵니다.
    Set swModel = swApp.ActiveDoc

    ' 모델이 열려 있는지 확인
    If swModel Is Nothing Then
        MsgBox "열려 있는 문서가 없습니다.", vbCritical
        Exit Sub
    End If

    ' 피처 "Fillet1" 가져오기
    Set swFeat = swModel.FeatureByName("Fillet1")
    
    If swFeat Is Nothing Then
        MsgBox "피처 Fillet1을 찾을 수 없습니다.", vbCritical
        Exit Sub
    End If

    ' 피처 유형이 "Fillet"인지 확인
    If swFeat.GetTypeName2 <> "Fillet" Then
        MsgBox "Fillet 피처가 아닙니다.", vbCritical
        Exit Sub
    End If

    ' "D1@Fillet1@Part1.Part" 차원 가져오기
    Set swDim = swModel.Parameter("D1@Fillet1@Part1.Part")
    
    If swDim Is Nothing Then
        MsgBox "차원 D1@Fillet1@Part1.Part을 찾을 수 없습니다.", vbCritical
        Exit Sub
    End If

    ' 차원의 값을 30으로 설정
    swDim.SystemValue = 30 / 1000 ' 단위는 미터(m)입니다.
    
    ' 모델 업데이트
    swModel.EditRebuild3
    MsgBox "차원 값이 30으로 성공적으로 변경되었습니다!", vbInformation
End Sub

 

---