轉檔顯示所需要的檔案名稱

baaltsai · 發表於 2016/6/25 18:40:30

如何轉出來的檔案呈現下列格式的檔案名稱,

第一種形式:
今天的日期-檔名.pdf
第二種形式:
料號-檔名-今天的日期.pdf

DaveChan · 發表於 2016/6/25 19:34:47

获取日期的代码,以下代码日期格式为双引号里面的内容,
yyyy代表年(2016)
mm代表月(06)
dd代表日(25)

Dim ShortDate As String
ShortDate = Format(Date, "yyyymmdd")

複製代碼

请问下料号是在模型属性里面吗？
如果是请问是在自定义属性还是配置特定里面？
保存的路径有什么要求？

baaltsai · 發表於 2016/6/27 11:07:05

1. 想在下列這巨集中增加可以轉出去的檔案名稱有:
第一種形式:
今天的日期-檔名.pdf
第二種形式:
料號-檔名-今天的日期.pdf

Sub main()
Set swApp = _
Application.SldWorks
Set Part = swApp.ActiveDoc
Part.ViewZoomtofit2
Part.ViewZoomtofit2
PartName = Part.GetTitle
PartName = Left(PartName, Len(PartName) - 6)
longstatus = Part.SaveAs3("C:" & PartName & ".PDF", 0, 0)
End Sub

複製代碼

2. 料號是在模型裡面輸入的

3.存檔路徑是固定的

DaveChan · 發表於 2016/6/27 14:25:05

baaltsai 發表於 2016/6/27 11:07
1. 想在下列這巨集中增加可以轉出去的檔案名稱有:
第一種形式:
今天的日期-檔名.pdf

第一種形式:
今天的日期-檔名.pdf

Dim swApp As Object
Dim Part As Object
Dim FilePathname As String
Dim FilePath As String
Dim PartName As String
Dim ShortDate As String
Sub main()
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
FilePathname = Part.GetPathName()
FilePath = Left(FilePathname, InStrRev(FilePathname, "") - 1)
PartName = Right(FilePathname, Len(FilePathname) - Len(FilePath) - 1)
PartName = Left(PartName, Len(PartName) - 7)
ShortDate = Format(Date, "yyyymmdd")
PartName = ShortDate & "-" & PartName
longstatus = Part.SaveAs3("C:" & PartName & ".PDF", 0, 0)
End Sub

複製代碼

第二种形式
PartNo 属性在模型的自定义属性中还是配置特定属性中？

baaltsai · 發表於 2016/6/27 15:49:56

在模型的自訂屬性輸入 PartNo 的.

DaveChan · 發表於 2016/6/27 18:15:50

第二種形式:
料號-檔名-今天的日期.pdf

Dim swApp As Object
Dim Part As Object
Dim FilePathname As String
Dim FilePath As String
Dim PartName As String
Dim ShortDate As String
Dim swView As SldWorks.View
Dim swDrawModel As SldWorks.ModelDoc2
Dim swModelDocExt As ModelDocExtension
Dim swCustProp As CustomPropertyManager
Dim bool As Boolean
Dim val As String
Dim valout As String
Dim longstatus As Boolean
Sub main()
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
FilePathname = Part.GetPathName()
FilePath = Left(FilePathname, InStrRev(FilePathname, "") - 1)
PartName = Right(FilePathname, Len(FilePathname) - Len(FilePath) - 1)
PartName = Left(PartName, Len(PartName) - 7)
ShortDate = Format(Date, "yyyymmdd")
Set swView = Part.GetFirstView
Set swView = swView.GetNextView
If swView Is Nothing Then
MsgBox "当前工程图未找到视图"
Exit Sub
End If
Set swDrawModel = swView.ReferencedDocument
Set swModelDocExt = swDrawModel.Extension
Set swCustProp = swModelDocExt.CustomPropertyManager("")
bool = swCustProp.Get4("PartNo", False, val, valout)
PartName = valout & "-" & PartName & "-" & ShortDate
longstatus = Part.SaveAs3("C:" & PartName & ".PDF", 0, 0)
End Sub

複製代碼

请测试，并告知结果

baaltsai · 發表於 2016/7/4 10:09:14

第一種 OK 沒問題

第二種
原本預設存檔路徑為 "C:\"
而我修改到 "C:\新增資料夾" 就會一直存檔到桌面上
這要怎樣修改呢?

baaltsai · 發表於 2016/7/4 10:09:28

DaveChan 發表於 2016/6/27 14:25
第一種形式:
今天的日期-檔名.pdf
第二种形式

OK 讚

DaveChan · 發表於 2016/7/4 11:10:40

baaltsai 發表於 2016/7/4 10:09
第一種 OK 沒問題

第二種

路径的最后需要有"\"
修改为："C:\新增資料夾\"
替换代码

longstatus = Part.SaveAs3("C:\新增資料夾" & PartName & ".PDF", 0, 0)

複製代碼

baaltsai · 發表於 2016/7/5 09:21:27

DaveChan 發表於 2016/6/27 18:15
第二種形式:
料號-檔名-今天的日期.pdf
请测试，并告知结果

ok
修改路徑後也ok

baaltsai · 發表於 2016/7/5 09:21:40

DaveChan 發表於 2016/7/4 11:10
路径的最后需要有"\"
修改为："C:\新增資料夾\"
替换代码

ok

baaltsai · 發表於 2016/7/5 09:23:00

3D要轉存step檔案,出現錯誤,那要如何修改(第二種形式)?
第一種形式: 今天的日期-檔名.step --> OK

第二種形式: 料號-檔名-今天的日期.step -->有錯誤

DaveChan · 發表於 2016/7/5 10:03:33

baaltsai 發表於 2016/7/5 09:23
3D要轉存step檔案,出現錯誤,那要如何修改(第二種形式)?
第一種形式: 今天的日期-檔名.step --> OK

第二种形式：模型转档STEP

Dim swApp As Object
Dim Part As Object
Dim FilePathname As String
Dim FilePath As String
Dim PartName As String
Dim ShortDate As String
Dim ConfName As String
Dim swModelDocExt As ModelDocExtension
Dim swCustProp As CustomPropertyManager
Dim bool As Boolean
Dim val As String
Dim valout As String
Dim longstatus As Boolean
Sub main()
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
FilePathname = Part.GetPathName()
FilePath = Left(FilePathname, InStrRev(FilePathname, "") - 1)
PartName = Right(FilePathname, Len(FilePathname) - Len(FilePath) - 1)
PartName = Left(PartName, Len(PartName) - 7)
ShortDate = Format(Date, "yyyymmdd")
ConfName = Part.GetActiveConfiguration.Name
Set swModelDocExt = Part.Extension
Set swCustProp = swModelDocExt.CustomPropertyManager(ConfName)
bool = swCustProp.Get4("PartNo", False, val, valout)
PartName = valout & "-" & PartName & "-" & ShortDate
longstatus = Part.SaveAs3("C:" & PartName & ".STEP", 0, 0)
End Sub

複製代碼

baaltsai · 發表於 2016/7/5 17:09:09

DaveChan 發表於 2016/7/5 10:03
第二种形式：模型转档STEP

都可以執行了,但出現一個很奇怪問題,

3D採用13樓的巨集轉STEP,但檔名跑出來的料號是在3D圖中屬性-->"模型組態指定" 裡面的 PartNo
2D採用6樓的巨轉PDF及DWG,但檔名跑出來的料號是在3D圖中屬性-->"自訂" 裡面的 PartNo

能否可以3D及2D都在"自訂"或是"模型組態指定",同一個位置的PartNo

DaveChan · 發表於 2016/7/5 19:46:16

baaltsai 發表於 2016/7/5 17:09
都可以執行了,但出現一個很奇怪問題,

3D採用13樓的巨集轉STEP,但檔名跑出來的料號是在3D圖中屬性-->"模 ...

将13楼代码修改为读取"自訂" 裡面的 PartNo

Dim swApp As Object
Dim Part As Object
Dim FilePathname As String
Dim FilePath As String
Dim PartName As String
Dim ShortDate As String
Dim swModelDocExt As ModelDocExtension
Dim swCustProp As CustomPropertyManager
Dim bool As Boolean
Dim val As String
Dim valout As String
Dim longstatus As Boolean
Sub main()
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
FilePathname = Part.GetPathName()
FilePath = Left(FilePathname, InStrRev(FilePathname, "") - 1)
PartName = Right(FilePathname, Len(FilePathname) - Len(FilePath) - 1)
PartName = Left(PartName, Len(PartName) - 7)
ShortDate = Format(Date, "yyyymmdd")
Set swModelDocExt = Part.Extension
Set swCustProp = swModelDocExt.CustomPropertyManager("")
bool = swCustProp.Get4("PartNo", False, val, valout)
PartName = valout & "-" & PartName & "-" & ShortDate
longstatus = Part.SaveAs3("C:" & PartName & ".STEP", 0, 0)
End Sub

複製代碼

baaltsai · 發表於 2016/7/6 15:39:27

DaveChan 發表於 2016/7/5 19:46
将13楼代码修改为读取"自訂" 裡面的 PartNo

可應用謝謝!!
寫這樣巨集有辦法轉STP檔時,帶有設定好的顏色嗎?

DaveChan · 發表於 2016/7/6 18:50:10

baaltsai 發表於 2016/7/6 15:39
可應用謝謝!!
寫這樣巨集有辦法轉STP檔時,帶有設定好的顏色嗎?

转换STP档带有颜色，在转换代码之前加入以下代码

swApp.SetUserPreferenceIntegerValue 75, 214

複製代碼

baaltsai · 發表於 2016/7/7 09:02:26

DaveChan 發表於 2016/7/6 18:50
转换STP档带有颜色，在转换代码之前加入以下代码

以上的執行都OK了
謝謝!!

baaltsai · 發表於 2016/7/22 17:50:17

DaveChan 發表於 2016/7/6 18:50
转换STP档带有颜色，在转换代码之前加入以下代码

有另外一個需求,

在自訂表格欄中,有兩列分別為PartNo 及 Test,

當轉出 PDF 及 DWG 及 STEP 自動形成這樣檔名:PartNoTest_圖檔檔名_日期.pdf

請問這要怎樣寫?

DaveChan · 發表於 2016/7/23 09:06:03

baaltsai 發表於 2016/7/22 17:50
有另外一個需求, 在自訂表格欄中,有兩列分別為PartNo 及 Test,當轉出 PDF 及 DWG 及 STEP 自動形成這樣檔 ...

完全可以利用15#代码，做点小改动就行了

baaltsai · 發表於 2016/7/23 15:16:34

DaveChan 發表於 2016/7/23 09:06
完全可以利用15#代码，做点小改动就行了

改不出來呢~~~

我有嘗試用成:
bool = swCustProp.Get4("Test", False, val, valout)
PartName = valout & "-" & PartName & "-" & ShortDate

但是是錯誤的

DaveChan · 發表於 2016/7/23 20:07:52

baaltsai 發表於 2016/7/23 15:16
改不出來呢~~~
我有嘗試用成:
bool = swCustProp.Get4("Test", False, val, valout)

Dim swApp As Object
Dim Part As Object
Dim FilePathname As String
Dim FilePath As String
Dim PartName As String
Dim ShortDate As String
Dim swModelDocExt As ModelDocExtension
Dim swCustProp As CustomPropertyManager
Dim bool As Boolean
Dim val As String
Dim valout As String
Dim val1 As String
Dim valout1 As String
Dim longstatus As Boolean
Sub main()
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
FilePathname = Part.GetPathName()
FilePath = Left(FilePathname, InStrRev(FilePathname, "") - 1)
PartName = Right(FilePathname, Len(FilePathname) - Len(FilePath) - 1)
PartName = Left(PartName, Len(PartName) - 7)
ShortDate = Format(Date, "yyyymmdd")
Set swModelDocExt = Part.Extension
Set swCustProp = swModelDocExt.CustomPropertyManager("")
bool = swCustProp.Get4("PartNo", False, val, valout)
bool = swCustProp.Get4("Test", False, val1, valout1)
PartName = valout & valout1 & "-" & PartName & "-" & ShortDate
longstatus = Part.SaveAs3("C:" & PartName & ".STEP", 0, 0)
End Sub

複製代碼

baaltsai · 發表於 2016/7/25 09:16:57

DaveChan 發表於 2016/7/23 20:07

謝謝驗證OK

baaltsai · 發表於 2016/7/25 09:16:58

DaveChan 發表於 2016/7/23 20:07

謝謝驗證OK

baaltsai · 發表於 2022/2/9 14:22:46

之前都是採用下面的巨集來轉檔，都是抓摘要資訊 --> 自訂裡面的資料，
要修改巨集，能否有心人幫忙修改為摘要資訊 --> 模型組態指定裡面的資料，
已嘗試修改，但失敗了。

Dim swApp As Object
Dim Part As Object
Dim FilePathname As String
Dim FilePath As String
Dim PartName As String
Dim ShortDate As String
Dim swView As SldWorks.View
Dim swDrawModel As SldWorks.ModelDoc2
Dim swModelDocExt As ModelDocExtension
Dim swCustProp As CustomPropertyManager
Dim bool As Boolean
Dim val As String
Dim valout As String
Dim val1 As String
Dim valout1 As String
Dim longstatus As Boolean
Sub main()
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Part.ViewZoomtofit2
FilePathname = Part.GetPathName()
FilePath = Left(FilePathname, InStrRev(FilePathname, "") - 1)
PartName = Right(FilePathname, Len(FilePathname) - Len(FilePath) - 1)
PartName = Left(PartName, Len(PartName) - 7)
ShortDate = Format(Date, "yyyymmdd")
Set swView = Part.GetFirstView
Set swView = swView.GetNextView
If swView Is Nothing Then
MsgBox "當前工程圖未找到視窗"
Exit Sub
End If
Set swDrawModel = swView.ReferencedDocument
Set swModelDocExt = swDrawModel.Extension
Set swCustProp = swModelDocExt.CustomPropertyManager("")
bool = swCustProp.Get4("Part number", False, val, valout)
bool = swCustProp.Get4("PAC", False, val1, valout1)
PartName = valout & valout1 & "_" & PartName & "_" & ShortDate
longstatus = Part.SaveAs3("D:" & PartName & ".DWG", 0, 0)
End Sub

複製代碼

kkovgto · 發表於 2022/8/3 21:44:54

baaltsai 發表於 2022/2/9 14:22
之前都是採用下面的巨集來轉檔，都是抓摘要資訊 --> 自訂裡面的資料，
要修改巨集，能否有心人幫忙修改為 ...

裡面有一行 Set swCustProp = swModelDocExt.CustomPropertyManager("")←這地方如果要指定模型組態時需輸入組態名稱，不輸入時會到自訂的組態
如下圖示↓↓

賬號		自動登錄	找回密碼
密碼			註冊

轉檔顯示所需要的檔案名稱

本帖子中包含更多資源

點評

點評

點評

點評

點評

點評

點評

點評

點評

點評

本帖子中包含更多資源

點評

本帖子中包含更多資源

點評

點評

點評

點評

本帖子中包含更多資源