본문 바로가기
  • Welcome!
VBA SOLIDWORK

BOM 컨셉 코드

by ToolBOX01 2024. 12. 20.
반응형
Option Explicit
Sub GetAssemblyStructure01()
    
    '// SolidWorks 객체 선언
    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim swAssembly As SldWorks.AssemblyDoc
    Dim swConfig As SldWorks.Configuration
    Dim swRootComponent As SldWorks.Component2

    '// 이미 실행 중인 SolidWorks 찾기
    Set swApp = GetObject(, "SldWorks.Application")
    Set swModel = swApp.IActiveDoc

    If swModel Is Nothing Then
        MsgBox "활성화된 문서를 찾을 수 없습니다.", vbExclamation, "오류"
        Exit Sub
    End If

    '// 문서 유형 확인
    If swModel.GetType <> swDocASSEMBLY Then
        MsgBox "활성화된 문서는 어셈블리가 아닙니다.", vbExclamation, "오류"
        Exit Sub
    End If

    '// 어셈블리 문서로 캐스팅
    Set swAssembly = swModel
    Set swConfig = swModel.GetActiveConfiguration
    Set swRootComponent = swConfig.GetRootComponent3(True) '//최상위 컴포넌트 가져오기


    ' 어셈블리 구조 출력
    MsgBox "어셈블리 구조:"
    TraverseComponents swRootComponent, 0
End Sub
Sub TraverseComponents(swComp As SldWorks.Component2, level As Integer)
    If swComp Is Nothing Then Exit Sub

    Dim WS As Worksheet
    Set WS = ThisWorkbook.Worksheets("Program06")

    ' 현재 컴포넌트 이름 출력
    Dim indent As String
    indent = String(level * 4, " ") ' 계층을 나타내는 들여쓰기

    ' Worksheet에 데이터 기록 (행은 동적으로 계산)
    Dim nextRow As Long
    nextRow = WS.Cells(WS.Rows.Count, "B").End(xlUp).Row + 1
    
    ' 파일 경로에서 파일 이름과 확장자 추출
    Dim filePath As String
    filePath = swComp.GetPathName
    
   ' Configuration 이름 가져오기 (상위 어셈블리에서 가져와야 함)
    Dim configurationNames As Variant
    configurationNames = swComp.GetConfigurationNames
    Dim configurationName As String
    If Not IsEmpty(configurationNames) Then
        If Not configurationNames(0) Like "*Default*" Then
            configurationName = "(" & configurationNames(0) & ")" ' 첫 번째 Configuration 이름 사용
        Else
            configurationName = ""
        End If
    End If
    
    Dim fileNameWithExtension As String
    fileNameWithExtension = Split(filePath, "\")(UBound(Split(filePath, "\")))
    
    '// A열에 순차적인 번호 부여
    WS.Cells(nextRow, "A").Value = nextRow - 5 ' //6행부터 시작하므로 4를 빼줌
    WS.Cells(nextRow, "B").Value = indent & fileNameWithExtension & configurationName
    WS.Cells(nextRow, "C").Value = level
    

    ' 하위 컴포넌트 가져오기
    Dim vChildComponents As Variant
    Dim swChildComp As SldWorks.Component2
    Dim i As Integer

    vChildComponents = swComp.GetChildren
    If Not IsEmpty(vChildComponents) Then
        For i = LBound(vChildComponents) To UBound(vChildComponents)
            Set swChildComp = vChildComponents(i)
            TraverseComponents swChildComp, level + 1
        Next i
    End If
End Sub


Sub DEL01()
  Worksheets("Program06").Rows(6 & ":" & Worksheets("Program06").Rows.Count).ClearContents
End Sub

 

solidworks02-BOM.xlsm
0.03MB

Configration 이름을 가져 옵니다.  솔리드웍스 어셈블리 파일을 Open 하고, 새로 고침을 클릭합니다.
초기화 버튼을 클릭하여, 표시된 내용을 제거 합니다. 

동일한 레벨에 있는 중복된 파일 이름을 제거 하는 기능이 요구 됩니다.
또한 표준 파라메터 이름이 표시 되록하는 기능이 필요 합니다.