반응형
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
Configration 이름을 가져 옵니다. 솔리드웍스 어셈블리 파일을 Open 하고, 새로 고침을 클릭합니다.
초기화 버튼을 클릭하여, 표시된 내용을 제거 합니다.
동일한 레벨에 있는 중복된 파일 이름을 제거 하는 기능이 요구 됩니다.
또한 표준 파라메터 이름이 표시 되록하는 기능이 필요 합니다.
'VBA SOLIDWORK' 카테고리의 다른 글
1. SldWorks.SldWorks 개념 (0) | 2024.12.24 |
---|---|
SOLIDWORKS 매크로 및 애드인 개발을 위한 API 개체 모델 이해 (0) | 2024.12.23 |
독립 프로그램 개발을 위한 VB.NET 개발 환경 설정 (1) | 2024.12.20 |
어셈블리 구조를 가져 오는 코드 - 컨셉 (0) | 2024.12.19 |
모델의 치수 이름 및 값을 가져오는 기능 (0) | 2024.12.17 |