通过SOLIDWORKS API导出组件坐标至CSV文件的实战操作

Const OUT_FILE_PATH As String = "D:\locations.csv"

Const CONV_FACTOR As Double = 1000 'meters to mm

Const OUT_FILE_PATH As String = "D:\locations.csv" '导出csv文件的地址
Const CONV_FACTOR As Double = 1000 'meters to mm

Dim swApp As SldWorks.SldWorks
Sub main()
    Set swApp = Application.SldWorks
    Dim swAssy As SldWorks.AssemblyDoc
    Set swAssy = swApp.ActiveDoc

    If Not swAssy Is Nothing Then
        Dim swSeedComp As SldWorks.Component2
				'选择集中的第一个组件
        Set swSeedComp = swAssy.SelectionManager.GetSelectedObjectsComponent4(1, -1)
        Dim table As String
        table = GetComponentsPositions(swAssy, swSeedComp, CONV_FACTOR)
				'将字符串写入CSV文件
        WriteTextFile OUT_FILE_PATH, table
    Else
        MsgBox "请打开装配体文档Please open assembly"
    End If
End Sub

Function GetComponentsPositions(assy As SldWorks.AssemblyDoc, seedComp As SldWorks.Component2, convFactor As Double) As String
    Dim table As String
    table = "Path,Configuration,Name,X,Y,Z"
    Dim vComps As Variant
		'获取装配体的活动配置中的所有零部件。
    vComps = assy.GetComponents(False)
    Dim i As Integer
    For i = 0 To UBound(vComps)
        Dim swComp As SldWorks.Component2
        Set swComp = vComps(i)
				'零件不是压缩状态
        If swComp.GetSuppression() <> swComponentSuppressionState_e.swComponentSuppressed Then
            Dim includeComp As Boolean '标记是否包含当前组件
            If seedComp Is Nothing Then
                includeComp = True '没有选择组件时全部包含
            ElseIf LCase(seedComp.GetPathName()) = LCase(swComp.GetPathName()) And LCase(seedComp.ReferencedConfiguration) = LCase(swComp.ReferencedConfiguration) Then
                includeComp = True '选择的组件包含，判断路径和引用配置相同
            Else
                includeComp = False '其余情况不包含
            End If
            If includeComp Then
                Dim vOrigin As Variant
                vOrigin = GetOrigin(swComp) '获取组件的相对坐标函数，返回数组
                table = table & vbLf '换行
                table = table & swComp.GetPathName() & "," & swComp.ReferencedConfiguration & "," & swComp.Name2 & "," & vOrigin(0) * convFactor & "," & vOrigin(1) * convFactor & "," & vOrigin(2) * convFactor
            End If
        End If
    Next
    GetComponentsPositions = table '返回字符串
End Function

Function GetOrigin(comp As SldWorks.Component2) As Variant
    Dim swXForm As SldWorks.MathTransform
    Set swXForm = comp.Transform2
    Dim swMathUtils As SldWorks.MathUtility
    Set swMathUtils = swApp.GetMathUtility
    Dim dPt(2) As Double
    dPt(0) = 0: dPt(1) = 0: dPt(2) = 0
    Dim swMathPt As SldWorks.MathPoint
		'创建新的数学点，不是草图点
    Set swMathPt = swMathUtils.CreatePoint(dPt)
		'将数学点乘以数学变换;点被旋转、缩放，然后被平移。
		'将坐标从组件坐标系转换到装配体坐标系
    Set swMathPt = swMathPt.MultiplyTransform(swXForm)
    GetOrigin = swMathPt.ArrayData '返回坐标数组
End Function

Sub WriteTextFile(filePath As String, content As String)
    Dim fileNmb As Integer
		'FreeFileh函数，获取一个可用的文件号，并将其存储在 fileNo 变量中，以便在后续的文件操作中使用
    fileNmb = FreeFile
    Open filePath For Output As #fileNmb '以写文件的方式打开文档
    Print #fileNmb, content '写入内容
    Close #fileNmb  '关闭csv文件
End Sub