设为首页收藏本站
开启辅助访问 切换到宽版

SolidWorks机械工程师网——最大的SolidWorks学习平台

 找回密码
 立即注册

QQ登录

只需一步，快速开始

SolidWorks机械工程师网——最大的SolidWorks学习平台»学习社区 › SolidWorks开发与拓展应用 › SolidWorks二次开发（宏，VBA） › 请教大佬们，怎么利用宏修改工程图图层。
返回列表 发新帖
查看: 3361|回复: 8
打印 上一主题 下一主题

请教大佬们，怎么利用宏修改工程图图层。

  [复制链接]
yni621

11

主题

504

帖子

1132

金币

传奇

Rank: 8Rank: 8

积分
5858

最佳新人活跃会员热心会员宣传达人灌水之王突出贡献
跳转到指定楼层
楼主
 楼主| 发表于 2020-7-21 11:33:47 | 只看该作者 |只看大图 回帖奖励 |倒序浏览 |阅读模式

   经典图书
泡论坛泡了好久，千辛万苦，在水底，找到了一个标注层的宏，这个宏可以自定义标注层为自己新建任意一个层，但是修改不了字体注释，自己也研究了好几天，修改了一下，但是还是不能自定义字体注释改为自己想要的图层。
帮忙解决一下，感谢大佬们。
图层宏
Const tolayer As String = "尺寸标注"                     '设置到标注层
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
    Set swapp = CreateObject("sldworks.application")     
    Set swmodel = swapp.ActiveDoc
    Set swdraw = swmodel

    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
    End Sub



分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏6 转播转播 分享教程|习题|模型|技巧 点赞点赞1 拍砖拍砖
SolidWorks机械工程师网
提示：建议使用谷歌浏览器浏览本网站！如单击这里下载！否则，可能无法下载附件文件！（支持大多数版本的谷歌浏览器，支持360和QQ浏览器的极速模式，即谷歌内核模式，使用IE和Edge浏览器，浏览个别网页以及下载文件时，会误报“***不安全”，此时需要单击“继续访问此不安全站点(不推荐)”才可以继续下载，另外，本网站不含任何不安全的文件，已联系微软公司解决，纯属IE和Edge浏览器误报）
回复

使用道具 举报

Allate

38

主题

1002

帖子

1万

金币

版主

Rank: 7Rank: 7Rank: 7Rank: 7

积分
24673

最佳新人活跃会员热心会员宣传达人灌水之王突出贡献
推荐
发表于 2020-11-27 16:55:13 | 只看该作者
这样？
  1. Const tolayer As String = "尺寸标注"                     '设置到标注层
  2. Sub main()
  3.     Dim swApp As SldWorks.SldWorks
  4.     Dim swModel As SldWorks.ModelDoc2
  5.     Dim swDraw As SldWorks.DrawingDoc
  6.     Dim swView As SldWorks.View
  7.     Dim swAnn As SldWorks.Annotation
  8.     Dim swDispdim As SldWorks.DisplayDimension
  9.     Dim swNote As SldWorks.Note
  10.     Dim numshts As Long
  11.     Dim i As Long
  12.     Set swApp = Application.SldWorks
  13.     Set swModel = swApp.ActiveDoc
  14.     Set swDraw = swModel

  16.     numshts = swDraw.GetSheetCount
  17.     For i = 1 To numshts
  18.       swDraw.SheetPrevious
  19.     Next i
  20.     For i = 1 To numshts
  21.       Set swView = swDraw.GetFirstView
  22.       While Not swView Is Nothing
  23.         Set swDispdim = swView.GetFirstDisplayDimension
  24.         Set swNote = swView.GetFirstNote
  25.         While Not swDispdim Is Nothing
  26.             Set swAnn = swDispdim.GetAnnotation
  27.             swAnn.Layer = tolayer
  28.             Set swDispdim = swDispdim.GetNext3
  29.         Wend
  30.         While Not swNote Is Nothing
  31.             Set swAnn = swNote.GetAnnotation
  32.             swAnn.Layer = tolayer
  33.             Set swNote = swNote.GetNext
  34.         Wend
  35.         Set swView = swView.GetNextView
  36.       Wend
  37.       swDraw.SheetNext
  38.     Next i
  39. End Sub
复制代码
SolidWorks机械工程师网
提示：建议使用谷歌浏览器浏览本网站！如单击这里下载！否则，可能无法下载附件文件！（支持大多数版本的谷歌浏览器，支持360和QQ浏览器的极速模式，即谷歌内核模式，使用IE和Edge浏览器，浏览个别网页以及下载文件时，会误报“***不安全”，此时需要单击“继续访问此不安全站点(不推荐)”才可以继续下载，另外，本网站不含任何不安全的文件，已联系微软公司解决，纯属IE和Edge浏览器误报）
回复 支持 1 反对 0

使用道具 举报

yni621

11

主题

504

帖子

1132

金币

传奇

Rank: 8Rank: 8

积分
5858

最佳新人活跃会员热心会员宣传达人灌水之王突出贡献
板凳
 楼主| 发表于 2020-7-21 11:37:24 | 只看该作者

   经典图书
使用提示，这个宏，把最上面那些中文改为工程图上面的图层，一键修改图层为你设置的图层。
SolidWorks机械工程师网
回复 支持 反对

使用道具 举报

yni621

11

主题

504

帖子

1132

金币

传奇

Rank: 8Rank: 8

积分
5858

最佳新人活跃会员热心会员宣传达人灌水之王突出贡献
地板
 楼主| 发表于 2020-7-23 10:38:24 | 只看该作者
顶一下，坐等高手！
SolidWorks机械工程师网
回复 支持 反对

使用道具 举报

juhnlon

4

主题

52

帖子

436

金币

堂主

Rank: 4

积分
684
QQ
5#
发表于 2020-7-28 20:45:57 | 只看该作者

   经典案例图书
好好学习，天天向上！
SolidWorks机械工程师网
回复 支持 反对

使用道具 举报

zhangcan0515

8

主题

114

帖子

31

金币

长老

Rank: 6Rank: 6Rank: 6

积分
1687

最佳新人活跃会员热心会员宣传达人
6#
发表于 2020-11-24 10:32:57 | 只看该作者
最近研究的咋样了。有什么进展没有
SolidWorks机械工程师网
回复 支持 反对

使用道具 举报

yni621

11

主题

504

帖子

1132

金币

传奇

Rank: 8Rank: 8

积分
5858

最佳新人活跃会员热心会员宣传达人灌水之王突出贡献
7#
 楼主| 发表于 2020-11-27 17:00:25 | 只看该作者

   经典案例图书
Allate 发表于 2020-11-27 16:55
这样？

哈哈，大佬果然厉害，改到同一图层，谢谢啊。
SolidWorks机械工程师网
回复 支持 反对

使用道具 举报

Allate

38

主题

1002

帖子

1万

金币

版主

Rank: 7Rank: 7Rank: 7Rank: 7

积分
24673

最佳新人活跃会员热心会员宣传达人灌水之王突出贡献
8#
发表于 2020-11-27 17:02:10 | 只看该作者
好像遍历一次，会把图框的字也变了图层，或者不遍历，只改一次？
  1. Const tolayer As String = "尺寸标注"                     '设置到标注层
  2. Sub main()
  3.     Dim swApp As SldWorks.SldWorks
  4.     Dim swModel As SldWorks.ModelDoc2
  5.     Dim swDraw As SldWorks.DrawingDoc
  6.     Dim swView As SldWorks.View
  7.     Dim swAnn As SldWorks.Annotation
  8.     Dim swDispdim As SldWorks.DisplayDimension
  9.     Dim swNote As SldWorks.Note
  10.     Dim numshts As Long
  11.     Dim i As Long
  12.     Set swApp = Application.SldWorks
  13.     Set swModel = swApp.ActiveDoc
  14.     Set swDraw = swModel

  16.     numshts = swDraw.GetSheetCount
  17.     For i = 1 To numshts
  18.       swDraw.SheetPrevious
  19.     Next i
  20.     For i = 1 To numshts
  21.       Set swView = swDraw.GetFirstView
  22.       While Not swView Is Nothing
  23.         Set swDispdim = swView.GetFirstDisplayDimension
  24.         Set swNote = swView.GetFirstNote
  25.         While Not swDispdim Is Nothing
  26.             Set swAnn = swDispdim.GetAnnotation
  27.             swAnn.Layer = tolayer
  28.             Set swDispdim = swDispdim.GetNext3
  29.         Wend
  30.         If Not swNote Is Nothing Then
  31.             Set swAnn = swNote.GetAnnotation
  32.             swAnn.Layer = tolayer
  33.             Set swNote = Nothing
  34.         End If
  35.         Set swView = swView.GetNextView
  36.       Wend
  37.       swDraw.SheetNext
  38.     Next i
  39. End Sub
复制代码
SolidWorks机械工程师网
回复 支持 反对

使用道具 举报

Allate

38

主题

1002

帖子

1万

金币

版主

Rank: 7Rank: 7Rank: 7Rank: 7

积分
24673

最佳新人活跃会员热心会员宣传达人灌水之王突出贡献
9#
发表于 2020-11-27 17:11:57 | 只看该作者
yni621 发表于 2020-11-27 17:00
哈哈，大佬果然厉害，改到同一图层，谢谢啊。

哈哈，别这样说，我也就是半桶水都不到，就会瞎编
SolidWorks机械工程师网
回复 支持 反对

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

SOLIDWORKS 2023 机械设计从入门到精通

手机版|小黑屋| GMT+8, 2025-5-25 15:39 , Processed in 0.191484 second(s), 22 queries , Memcache On.

SolidWorks机械工程师网 ( 鲁ICP备14025122号-2 ) 鲁公网安备 37028502190335号

声明：本网言论纯属发表者个人意见，与本网立场无关。
如涉版权，可发邮件： admin@swbbsc.com

快速回复 返回顶部 返回列表