3.SldWorks.Feature 개념

Dim swFeature As SldWorks.Feature는 SolidWorks API를 사용하여 VBA에서 특정 Feature를 참조하기 위한 객체를 선언하는 구문입니다. 여기서 SldWorks.Feature는 SolidWorks의 특정 설계 요소( Feature)를 나타내는 객체 유형입니다.

SldWorks.Feature Members

IFeature Interface Members - 2024 - SOLIDWORKS API Help

 

예제: 모델이 가지고 있는 Feature의 이름을 가져오는 코드

Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swFeat As SldWorks.Feature

Sub main()
    ' SOLIDWORKS 애플리케이션 객체 가져오기
    On Error Resume Next
    Set swApp = GetObject(, "SldWorks.Application")
    On Error GoTo 0
    If swApp Is Nothing Then
        MsgBox "SOLIDWORKS를 찾을 수 없습니다. 실행 중인지 확인하세요.", vbCritical
        Exit Sub
    End If

    ' 활성 문서 가져오기
    Set swModel = swApp.ActiveDoc
    If swModel Is Nothing Then
        MsgBox "활성화된 문서를 찾을 수 없습니다. 문서를 열고 다시 시도하세요.", vbCritical
        Exit Sub
    End If

    ' Feature 순회
    Set swFeat = swModel.FirstFeature
    If swFeat Is Nothing Then
        MsgBox "모델에 Feature가 없습니다.", vbExclamation
        Exit Sub
    End If

    Debug.Print "모델의 Feature 목록:"
    Debug.Print "-----------------------"

    Do While Not swFeat Is Nothing
        ' Feature 이름과 유형 가져오기
        Debug.Print "Feature Name: " & swFeat.Name & ", Feature Type: " & swFeat.GetTypeName2()
        ' 다음 Feature로 이동
        Set swFeat = swFeat.GetNextFeature
    Loop

    MsgBox "모든 Feature 이름이 Immediate 창에 출력되었습니다.", vbInformation
End Sub

 

Model	실행 결과

 

예제: 모델이 가지고 있는 Feature의 이름, 순서, Feature의 고유 식별자 Persistent Reference ID를 가져오기

Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swFeat As SldWorks.Feature

Sub main()
    ' SOLIDWORKS 애플리케이션 객체 가져오기
    On Error Resume Next
    Set swApp = GetObject(, "SldWorks.Application")
    On Error GoTo 0
    If swApp Is Nothing Then
        MsgBox "SOLIDWORKS를 찾을 수 없습니다. 실행 중인지 확인하세요.", vbCritical
        Exit Sub
    End If

    ' 활성 문서 가져오기
    Set swModel = swApp.ActiveDoc
    If swModel Is Nothing Then
        MsgBox "활성화된 문서를 찾을 수 없습니다. 문서를 열고 다시 시도하세요.", vbCritical
        Exit Sub
    End If

    ' Feature 순회
    Set swFeat = swModel.FirstFeature
    If swFeat Is Nothing Then
        MsgBox "모델에 Feature가 없습니다.", vbExclamation
        Exit Sub
    End If

    Dim featureIndex As Long
    featureIndex = 1 ' Feature 순서를 위한 변수

    Debug.Print "모델의 Feature 목록 (순서 포함):"
    Debug.Print "--------------------------------"

    Do While Not swFeat Is Nothing
        ' Feature 이름, 유형, ID 가져오기
        Dim featName As String, featType As String, featID As String
        featName = swFeat.Name
        featType = swFeat.GetTypeName2()
        featID = swFeat.GetID()

        ' Immediate 창에 출력
        Debug.Print featureIndex & ". Feature Name: " & featName & ", Feature Type: " & featType & ", ID: " & featID
        
        ' 다음 Feature로 이동
        Set swFeat = swFeat.GetNextFeature
        featureIndex = featureIndex + 1 ' 순서 증가
    Loop

    MsgBox "모든 Feature 이름, 순서 및 ID가 Immediate 창에 출력되었습니다.", vbInformation
End Sub

 

프로그램 실행 결과

모델의 Feature 목록 (순서 포함):
--------------------------------
1. Feature Name: Front Plane, Feature Type: RefPlane, ID: 12345678
2. Feature Name: Top Plane, Feature Type: RefPlane, ID: 23456789
3. Feature Name: Right Plane, Feature Type: RefPlane, ID: 34567890
4. Feature Name: Origin, Feature Type: Origin, ID: 45678901
5. Feature Name: Boss-Extrude1, Feature Type: BossExtrude, ID: 56789012
6. Feature Name: Cut-Extrude1, Feature Type: CutExtrude, ID: 67890123

 

예제 : 치수 값만 있는 Feature 이름 및 고유 식별자 Persistent Reference ID를 가져오기

Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swFeat As SldWorks.Feature
Dim swParam As SldWorks.Parameter

Sub main()
    ' SOLIDWORKS 애플리케이션 객체 가져오기
    On Error Resume Next
    Set swApp = GetObject(, "SldWorks.Application")
    On Error GoTo 0
    If swApp Is Nothing Then
        MsgBox "SOLIDWORKS를 찾을 수 없습니다. 실행 중인지 확인하세요.", vbCritical
        Exit Sub
    End If

    ' 활성 문서 가져오기
    Set swModel = swApp.ActiveDoc
    If swModel Is Nothing Then
        MsgBox "활성화된 문서를 찾을 수 없습니다. 문서를 열고 다시 시도하세요.", vbCritical
        Exit Sub
    End If

    ' Feature 순회
    Set swFeat = swModel.FirstFeature
    If swFeat Is Nothing Then
        MsgBox "모델에 Feature가 없습니다.", vbExclamation
        Exit Sub
    End If

    Debug.Print "치수값이 있는 Feature 목록:"
    Debug.Print "--------------------------------"

    Do While Not swFeat Is Nothing
        ' Feature가 치수를 포함하고 있는지 확인
        Dim hasDimension As Boolean
        hasDimension = FeatureHasDimension(swFeat)

        If hasDimension Then
            ' Feature 이름과 ID 가져오기
            Dim featName As String, featID As String
            featName = swFeat.Name
            featID = swFeat.GetID()

            ' Immediate 창에 출력
            Debug.Print "Feature Name: " & featName & ", Persistent Reference ID: " & featID
        End If

        ' 다음 Feature로 이동
        Set swFeat = swFeat.GetNextFeature
    Loop

    MsgBox "치수값이 있는 Feature 이름과 ID가 Immediate 창에 출력되었습니다.", vbInformation
End Sub

' Feature에 치수값이 있는지 확인하는 함수
Function FeatureHasDimension(feat As SldWorks.Feature) As Boolean
    Dim swDispDim As SldWorks.DisplayDimension
    Dim swChildFeat As SldWorks.Feature

    ' Feature 내부의 치수 확인
    Set swDispDim = feat.GetFirstDisplayDimension()
    If Not swDispDim Is Nothing Then
        FeatureHasDimension = True
        Exit Function
    End If

    ' 하위 Feature 검사
    Set swChildFeat = feat.GetFirstSubFeature()
    Do While Not swChildFeat Is Nothing
        If FeatureHasDimension(swChildFeat) Then
            FeatureHasDimension = True
            Exit Function
        End If
        Set swChildFeat = swChildFeat.GetNextSubFeature()
    Loop

    ' 치수가 없으면 False 반환
    FeatureHasDimension = False
End Function

 

프로그램 실행 결과

치수값이 있는 Feature 목록:
--------------------------------
Feature Name: Boss-Extrude1, Persistent Reference ID: 12345678
Feature Name: Cut-Extrude1, Persistent Reference ID: 23456789
Feature Name: Fillet1, Persistent Reference ID: 34567890

 

예제 : 치수 값만 있는 Feature 이름 및 고유 식별자 Persistent Reference ID, Dimension Name, Value

 

Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swFeat As SldWorks.Feature

Sub ExportToExcel()
    ' SOLIDWORKS 애플리케이션 객체 가져오기
    On Error Resume Next
    Set swApp = GetObject(, "SldWorks.Application")
    On Error GoTo 0
    If swApp Is Nothing Then
        MsgBox "SOLIDWORKS를 찾을 수 없습니다. 실행 중인지 확인하세요.", vbCritical
        Exit Sub
    End If

    ' 활성 문서 가져오기
    Set swModel = swApp.ActiveDoc
    If swModel Is Nothing Then
        MsgBox "활성화된 문서를 찾을 수 없습니다. 문서를 열고 다시 시도하세요.", vbCritical
        Exit Sub
    End If

    ' Excel 애플리케이션 객체 가져오기
    Dim xlApp As Object
    Dim xlBook As Object
    Dim xlSheet As Object
    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    If xlApp Is Nothing Then
        Set xlApp = CreateObject("Excel.Application")
    End If
    On Error GoTo 0

    If xlApp Is Nothing Then
        MsgBox "Excel을 실행할 수 없습니다.", vbCritical
        Exit Sub
    End If

    ' Excel 워크북 및 워크시트 생성
    xlApp.Visible = True
    Set xlBook = xlApp.Workbooks.Add
    Set xlSheet = xlBook.Worksheets(1)

    ' 워크시트에 헤더 추가
    xlSheet.Cells(1, 1).Value = "Feature Name"
    xlSheet.Cells(1, 2).Value = "Feature Type"
    xlSheet.Cells(1, 3).Value = "Persistent Reference ID"
    xlSheet.Cells(1, 4).Value = "Dimensions"

    ' Feature 순회 및 데이터 추가
    Set swFeat = swModel.FirstFeature
    Dim rowIndex As Long
    rowIndex = 2 ' 데이터는 2번째 행부터 시작

    Do While Not swFeat Is Nothing
        Dim featName As String, featType As String, featID As String, dimensions As String
        featName = swFeat.Name
        featType = swFeat.GetTypeName2()
        featID = swFeat.GetID()
        dimensions = GetFeatureDimensions(swFeat)

        ' Excel에 데이터 쓰기
        xlSheet.Cells(rowIndex, 1).Value = featName
        xlSheet.Cells(rowIndex, 2).Value = featType
        xlSheet.Cells(rowIndex, 3).Value = featID
        xlSheet.Cells(rowIndex, 4).Value = dimensions

        ' 다음 Feature로 이동
        Set swFeat = swFeat.GetNextFeature
        rowIndex = rowIndex + 1
    Loop

    MsgBox "SOLIDWORKS 모델 데이터가 Excel로 내보내졌습니다.", vbInformation
End Sub

' Feature의 치수값 가져오기
Function GetFeatureDimensions(feat As SldWorks.Feature) As String
    Dim swDispDim As SldWorks.DisplayDimension
    Dim dimString As String
    dimString = ""

    ' Feature 내부 치수 확인
    Set swDispDim = feat.GetFirstDisplayDimension()
    Do While Not swDispDim Is Nothing
        Dim swDim As SldWorks.Dimension
        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