请问有没有一键改图纸格式的宏

wwwerzhou · 发表于 2022-6-6 13:53:50

经典图书

请问有没有一键改图纸格式的宏,如图片所示，一键改图纸格式宏，一键改绘图标准宏，两个宏命令

心无止境 · 发表于 2022-6-11 17:44:03

模板路径自己设置下，2018测试没有问题，感谢@yni621 的更换图层代码

Alex_Wang · 发表于 2022-6-7 08:58:57

经典图书

顶一下！！！！！！！！！！！！！！！

sunwise · 发表于 2022-6-7 13:20:39

顶一下，坐等高手！

wetiuer · 发表于 2022-6-7 15:45:31

经典案例图书

论坛中更换图纸模板的宏有很多，可以搜索一下。大概代码如下（VB.NET）

Private Sub ReplaceDrawingTemplate(ByRef swDraw As DrawingDoc, ByVal DrawingTemplateDic As Dictionary(Of Integer, String))
Dim swSheet As Sheet
Dim sheetProperties As Double()
Dim vSheetName As Object()
vSheetName = swDraw.GetSheetNames
For Each sheetName As String In vSheetName
swDraw.ActivateSheet(sheetName)
swSheet = swDraw.Sheet(sheetName)
sheetProperties = swSheet.GetProperties2
For Each temp As KeyValuePair(Of Integer, String) In DrawingTemplateDic
If temp.Key = sheetProperties(0) Then
swSheet.SetProperties2(sheetProperties(0), swDwgTemplates_e.swDwgTemplateCustom, sheetProperties(2), sheetProperties(3), sheetProperties(4), sheetProperties(5), sheetProperties(6), sheetProperties(7))
swSheet.SetTemplateName(temp.Value)
swSheet.ReloadTemplate(False)
End If
Next
Next
End Sub

复制代码

另外有一个批量工具实现，如下图

wwwerzhou · 发表于 2022-6-8 10:15:30

wetiuer 发表于 2022-6-7 15:45
论坛中更换图纸模板的宏有很多，可以搜索一下。大概代码如下（VB.NET）
另外有一个批量工具实现，如下图
...

感谢，批量复制有好多插件也可以，就是有时候需要单个的，一键宏命令

心无止境 · 发表于 2022-6-9 20:59:42

经典案例图书

可以实现的

wwwerzhou · 发表于 2022-6-10 16:23:10

心无止境发表于 2022-6-9 20:59
可以实现的

插件在哪下载，谢谢

心无止境 · 发表于 2022-6-10 22:43:16

wwwerzhou 发表于 2022-6-10 16:23
插件在哪下载，谢谢

插件暂时不对外开放，可以给你写个宏

wwwerzhou · 发表于 2022-6-11 08:27:54

经典图书

心无止境发表于 2022-6-10 22:43
插件暂时不对外开放，可以给你写个宏

感谢老师，麻烦写个宏

心无止境 · 发表于 2022-6-11 17:51:45

wwwerzhou 发表于 2022-6-11 08:27
感谢老师，麻烦写个宏

标准层自己也要改下或者设置成和宏里面的一样

DFFDSGG114485 · 发表于 2022-6-12 19:52:32

感谢楼主分享，很不错！

淡淡的雲 · 发表于 2022-6-12 21:02:34

很不错，找到组织了！

wwwerzhou · 发表于 2022-6-13 10:49:41

心无止境发表于 2022-6-11 17:44
模板路径自己设置下，2018测试没有问题，感谢@yni621 的更换图层代码

大师你好，是不是这几个打钩的都需要更改啊？
你看看我改的对不对，还有能不能含中文字？

心无止境 · 发表于 2022-6-13 13:00:16

加入QQ群
参与讨论和学习

或扫描二维码加入

wwwerzhou 发表于 2022-6-13 10:49
大师你好，是不是这几个打钩的都需要更改啊？
你看看我改的对不对，还有能不能含中文字？

是的呀，全路径就行了

wwwerzhou · 发表于 2022-6-13 15:17:28

经典案例图书

心无止境发表于 2022-6-13 13:00
是的呀，全路径就行了

我可以看一下你的设置吗，就像我截图的那个，我设置好之后，只有图层改过来了，其他的都没变过来，不知道是不是我哪里没设置对

wwwerzhou · 发表于 2022-6-14 09:21:52

加入QQ群
参与讨论和学习

或扫描二维码加入

心无止境发表于 2022-6-13 13:00
是的呀，全路径就行了

Const tolayer As String = "FORMAT"                   '设置到标注层
Sub main()
Dim swapp As SldWorks.SldWorks
Dim swmodel As SldWorks.ModelDoc2
Dim swdraw As SldWorks.DrawingDoc
Dim swview As SldWorks.View
Dim swann As SldWorks.Annotation
Dim swdispdim As SldWorks.DisplayDimension
Dim numshts As Long
Dim i As Long
Dim swErrors As Long
Dim swWarnings As Long
Dim boolstatus As Boolean
Dim Sheet As Object
Dim SheetPr() As Double
Dim SheetName As String
Dim StdFile As String
Set swapp = CreateObject("sldworks.application")
Set swmodel = swapp.ActiveDoc
Set swdraw = swmodel
Set Sheet = swdraw.GetCurrentSheet()
SheetPr = Sheet.GetProperties2()
SheetPr(0) = 12
SheetPr(1) = 12
If swmodel Is Nothing Then
swapp.SendMsgToUser ("当前没有任何文档打开，该程序必须在工程图中运行！")
Exit Sub
ElseIf swmodel.GetType <> 3 Then
swapp.SendMsgToUser ("当前打开的文档不是一个工程图，请打开工程图后再试！")
Exit Sub
End If
boolstatus = Sheet.SetProperties2(SheetPr(0), SheetPr(1), SheetPr(2), SheetPr(3), SheetPr(4), SheetPr(5), SheetPr(6), SheetPr(7))
StdFile = "E:\Program Files\MOBAN\GCTMB.drwdot" '双引号内填写工程图模板完整的地址及后缀.drwdot
If SheetPr(5) = 1189 / 1000 And SheetPr(6) = 841 / 1000 Then 'A0图幅
Sheet.SetTemplateName ("")
swdraw.Extension.LoadDraftingStandard StdFile
ElseIf SheetPr(5) = 841 / 1000 And SheetPr(6) = 594 / 1000 Then 'A1图幅
Sheet.SetTemplateName ("")
swdraw.Extension.LoadDraftingStandard StdFile
ElseIf SheetPr(5) = 594 / 1000 And SheetPr(6) = 420 / 1000 Then 'A2图幅
Sheet.SetTemplateName ("")
swdraw.Extension.LoadDraftingStandard StdFile
ElseIf SheetPr(5) = 420 / 1000 And SheetPr(6) = 297 / 1000 Then 'A3图幅
Sheet.SetTemplateName ("")
swdraw.Extension.LoadDraftingStandard StdFile
ElseIf SheetPr(5) = 297 / 1000 And SheetPr(6) = 210 / 1000 Then 'A4图幅
Sheet.SetTemplateName ("E:\Program Files\MOBAN\THTK.slddrt") '双引号内填写图纸格式完整的地址及后缀.slddrt
swdraw.Extension.LoadDraftingStandard StdFile
ElseIf SheetPr(5) = 210 / 1000 And SheetPr(6) = 297 / 1000 Then 'A4p图幅
Sheet.SetTemplateName ("")
swdraw.Extension.LoadDraftingStandard StdFile
End If
'更换绘图标准
boolstatus = swdraw.Extension.LoadDraftingStandard("E:\Program Files\MOBAN\GBXG.sldstd") '双引号内填写绘图标准完整的地址及后缀.sldstd
Sheet.ReloadTemplate (False) '重装图纸格式，删除原有注释
'更换图层
numshts = swdraw.GetSheetCount
For i = 1 To numshts
  swdraw.SheetPrevious
Next i
For i = 1 To numshts
  Set swview = swdraw.GetFirstView
  While Not swview Is Nothing
  Set swdispdim = swview.GetFirstDisplayDimension
  While Not swdispdim Is Nothing
  Set swann = swdispdim.GetAnnotation
  swann.Layer = tolayer
  Set swdispdim = swdispdim.GetNext3
  Wend
  Set swview = swview.GetNextView
  Wend
  swdraw.SheetNext
  Next i
boolstatus = swdraw.Save3(1, swErrors, swWarnings) '保存
swapp.SendMsgToUser ("已完成")
End Sub

Alex_Wang · 发表于 2022-6-14 11:23:01

经典案例图书

心无止境发表于 2022-6-11 17:44
模板路径自己设置下，2018测试没有问题，感谢@yni621 的更换图层代码

感谢大神无私分享！！！！！！！！！！！！！！！！

duanli96 · 发表于 2022-9-14 09:57:07

心无止境发表于 2022-6-9 20:59
可以实现的

大佬，插件能分享吗

心无止境 · 发表于 2022-10-14 09:14:05

duanli96 发表于 2022-9-14 09:57
大佬，插件能分享吗

不好意思，这个暂时不对外。

		自动登录	找回密码
密码			立即注册

请问有没有一键改图纸格式的宏

浏览过的版块

最佳新人

活跃会员

热心会员

宣传达人

灌水之王

突出贡献