좌표계 생성 매크로

Solid Edge 좌표계 자동 작성 매크로 입니다.

Excel 이용해 좌표계 생성 하는 매크로입니다.

코드 소스

Option Explicit

'Excel -> Edge
Sub Make_Coordnate()
On Error Resume Next

Dim EDGE As SolidEdgeFramework.Application
Dim EDoc As SolidEdgePart.PartDocument
Dim OldStBar As String

Set EDGE = GetObject(, "SolidEdge.Application")
If EDGE Is Nothing Then
    Err.Clear
    Set EDGE = CreateObject("SolidEdge.Application")
    Set EDoc = EDGE.Documents.Add("SolidEdge.PartDocument")
    EDGE.Visible = True
    EDGE.DisplayFullScreen = True
Else
      Set EDoc = EDGE.Documents.Add("SolidEdge.PartDocument")
End If

EDoc.Application.ScreenUpdating = False
OldStBar = EDGE.StatusBar

Dim AXIS As Object
Dim i As Integer
Dim K As Integer
Dim X As Double
Dim Y As Double
Dim Z As Double
Dim No As String

On Error GoTo ET

K = Cells(Rows.Count, "a").End(xlUp).Row

For i = 4 To K Step 3
If Cells(i + 2, 3) <> 0 And Cells(i + 1, 3) <> 0 And Cells(i, 3) <> 0 Then
    X = Cells(i, 3) / 1000
    Y = Cells(i + 1, 3) / 1000
    Z = Cells(i + 2, 3) / 1000
    No = Cells(i, 1)
    EDGE.StatusBar = "  Task Progress   " & Round(i / K * 100, 0) & "%"
    Set AXIS = EDoc.CoordinateSystems.Add(X, Y, Z)
    AXIS.Name = No
End If

Next

EDGE.StatusBar = OldStBar
EDoc.Application.ScreenUpdating = True
Call EDoc.Recompute

Exit Sub

ET:
EDoc.Application.ScreenUpdating = True
Call EDoc.Recompute
MsgBox "Error...", "wkdghfl@gmail.com"

End Sub

Excel 파일

소스를 직접 편집해 사용하시거나 아래의 Excel 파일을 이용하시면 됩니다.

좌측은 좌표계 이름, 우측이 축 거리값 입니다.

두 부분을 입력후 실행하면 좌표계가 생성됩니다.

Creates Coordinate.xlsm