怎么将钣金展开图保存CAD时，文件名添加厚度-材料-数量

youyouyangzi201

   经典图书

SW用宏将钣金平板形式输出CAD，文件名格式：厚度mm--材料--数量--零件图号

wetiuer

如果你的钣金零件自定义是属性有这四个属性，就可以直接获取值，按格式保存导出的CAD文件。如果没有数量，只能通过装配体统计数量了。

youyouyangzi201

   经典图书

wetiuer 发表于 2023-5-20 16:53
如果你的钣金零件自定义是属性有这四个属性，就可以直接获取值，按格式保存导出的CAD文件。如果没有数量， ...

自定义属性内有这几个属性，怎么获取啊，刚学习SW宏不久，求大佬多多指教

Option Explicit
Dim swApp               As SldWorks.SldWorks
Dim swModel             As SldWorks.ModelDoc2
Dim FilePath            As String
Dim FileTitle           As String
Dim swFeatName          As String
Dim swFeatType          As Integer
Dim NewFilePath         As String
Dim dwgName             As String
Dim dataAlignment(11)   As Double
Dim fso                 As Object
Dim Rng()               As Variant
Dim i                   As Integer

Sub 钣金零件转平板图DWG()

    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set fso = CreateObject("Scripting.FileSystemObject")
    FilePath = swModel.GetPathName
    FileTitle = Mid(FilePath, InStrRev(FilePath, "\") + 1, Len(FilePath) - InStrRev(FilePath, "\") - 7)
    FilePath = Left(FilePath, InStrRev(FilePath, "\"))

    i = 0
    Do While True
        swFeatName = swModel.FeatureByPositionReverse(i).Name
        swFeatType = swModel.FeatureByPositionReverse(i).GetType
        If swFeatType = 22 Then
            ReDim Preserve Rng(i)
            Rng(i) = swFeatName
        Else
            Exit Do
        End If
        i = i + 1
    Loop

    NewFilePath = FilePath + FileTitle + ".dwg" '定义工程图名
        dataAlignment(0) = 0#
        dataAlignment(1) = 0#
        dataAlignment(2) = 0#
        dataAlignment(3) = 0#
        dataAlignment(4) = 0#
        dataAlignment(5) = 0#
        dataAlignment(6) = 0#
        dataAlignment(7) = 0#
        dataAlignment(8) = 0#
        dataAlignment(9) = 0#
        dataAlignment(10) = 0#
        dataAlignment(11) = 0#

    swModel.ExportToDWG2 NewFilePath, FileTitle, 1, False, dataAlignment, False, False, 1, Null   '不需要折弯线时，把后面的5改成1

    For i = 0 To UBound(Rng)
        dwgName = FilePath + Rng(i) + " - " + FileTitle + ".dwg"
        If Dir(dwgName) <> "" Then
            fso.MoveFile dwgName, FilePath + FileTitle + "-" + Rng(i) + ".dwg"
        End If
    Next i

End Sub

youyouyangzi201

这4个属性自定义里有，怎么获取啊，大佬教一下哈

Option Explicit
Dim swApp               As SldWorks.SldWorks
Dim swModel             As SldWorks.ModelDoc2
Dim FilePath            As String
Dim FileTitle           As String
Dim swFeatName          As String
Dim swFeatType          As Integer
Dim NewFilePath         As String
Dim dwgName             As String
Dim dataAlignment(11)   As Double
Dim fso                 As Object
Dim Rng()               As Variant
Dim i                   As Integer

Sub 钣金零件转平板图DWG()

    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set fso = CreateObject("Scripting.FileSystemObject")
    FilePath = swModel.GetPathName
    FileTitle = Mid(FilePath, InStrRev(FilePath, "\") + 1, Len(FilePath) - InStrRev(FilePath, "\") - 7)
    FilePath = Left(FilePath, InStrRev(FilePath, "\"))

    i = 0
    Do While True
        swFeatName = swModel.FeatureByPositionReverse(i).Name
        swFeatType = swModel.FeatureByPositionReverse(i).GetType
        If swFeatType = 22 Then
            ReDim Preserve Rng(i)
            Rng(i) = swFeatName
        Else
            Exit Do
        End If
        i = i + 1
    Loop

    NewFilePath = FilePath + FileTitle + ".dwg" '定义工程图名
        dataAlignment(0) = 0#
        dataAlignment(1) = 0#
        dataAlignment(2) = 0#
        dataAlignment(3) = 0#
        dataAlignment(4) = 0#
        dataAlignment(5) = 0#
        dataAlignment(6) = 0#
        dataAlignment(7) = 0#
        dataAlignment(8) = 0#
        dataAlignment(9) = 0#
        dataAlignment(10) = 0#
        dataAlignment(11) = 0#

    swModel.ExportToDWG2 NewFilePath, FileTitle, 1, False, dataAlignment, False, False, 1, Null   '不需要折弯线时，把后面的5改成1

    For i = 0 To UBound(Rng)
        dwgName = FilePath + Rng(i) + " - " + FileTitle + ".dwg"
        If Dir(dwgName) <> "" Then
            fso.MoveFile dwgName, FilePath + FileTitle + "-" + Rng(i) + ".dwg"
        End If
    Next i

End Sub

harrisharris

   经典案例图书

很不错，顶一下！

qqfly332211

活到老学到老！

h2409092

   经典案例图书

活到老学到老

zxt0824

好东西，努力学习学习！

daghhah4r

好东西，努力学习学习！