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

标题: 求自动将相关标注移动到指定的图层 [打印本页]

作者: arter_2006 时间: 2022-7-21 11:39
标题: 求自动将相关标注移动到指定的图层
求一宏，将指定的标注内容移动到指定的图层，如：
尺寸标注——移动到——尺寸图层
符号标注，如基准符号、加工符号服、粗糙度符号、焊接符号移动到——符号图层
技术要求、材料明细表移动到——文字层

作者: arter_2006 时间: 2022-7-22 08:48
有没有知道的大侠

作者: liyong123456 时间: 2022-7-22 19:50
顶一下，坐等高手！

作者: 17664109763 时间: 2022-7-27 13:08
顶一下，坐等高手！

作者: arter_2006 时间: 2022-8-2 10:24
顶一下，坐等高手！

作者: zzm5337 时间: 2022-8-3 11:05
SolidWorks机械工程师网，顶一下。

作者: Allate 时间: 2022-8-26 09:00
还有需求么？有的话帮你弄一个

作者: lxr8833661 时间: 2022-8-26 13:37

Allate 发表于 2022-8-26 09:00
还有需求么？有的话帮你弄一个

有有有

作者: arter_2006 时间: 2022-8-26 18:40

Allate 发表于 2022-8-26 09:00
还有需求么？有的话帮你弄一个

感谢，不需要了。我抽空把好的发上来

作者: arter_2006 时间: 2022-8-26 18:42

Allate 发表于 2022-8-26 09:00
还有需求么？有的话帮你弄一个

请教一下，下面两句该如何写？谢谢！
选取顶层的装配体，
选择所有隐藏的零部件（相当于过滤选择中的“选取隐藏”命令，就是选择打开的装配体中所有的、不管所在子装配体层级的被隐藏的零部件）

作者: yudian584520 时间: 2022-8-27 15:58
顶一下，坐等高手！

作者: arter_2006 时间: 2022-8-29 14:11
下载后把文件后缀.rar改为.swp即可,solidworks 2019,不知道低版本能否打开，我把代码也贴上来。

注：此非本人所能，乃高手随手所做。谢谢帮助！

Const toLayer1 As String = "尺寸标注"
Const toLayer2 As String = "中心线"
Const toLayer3 As String = "文字"
Const toLayer4 As String = "符号"

Sub main()
  Dim swApp As SldWorks.SldWorks
  Dim swModel As SldWorks.ModelDoc2
  Dim LyrMgr As LayerMgr
  Dim Layer As Variant
  Dim swDraw As SldWorks.DrawingDoc
  Dim swView As SldWorks.View
  Dim swAnn As SldWorks.Annotation
  Dim swDispDim As SldWorks.DisplayDimension
  Dim swCenterLine As SldWorks.Centerline
  Dim swCtrMark As SldWorks.CenterMark
  Dim swNote As SldWorks.Note
  Dim swWeldSymbol As SldWorks.WeldSymbol
  Dim swSFSymbol As SldWorks.SFSymbol
  Dim swAnnDatumTag As SldWorks.DatumTag
  Dim swAnnDatumTargetSym As SldWorks.DatumTargetSym

  Dim numshts As Long
  Dim i As Long
  Dim SheetName() As String
  Set swApp = CreateObject("sldworks.Application")
  Set swModel = swApp.ActiveDoc
  Set LyrMgr = swModel.GetLayerManager
  Set swDraw = swModel

  LyrMgr.DeleteLayer ("尺寸标注")
  Layer = LyrMgr.AddLayer("尺寸标注", "尺寸标注", RGB(0, 128, 0), 0, 0) '指定顏色
  LyrMgr.DeleteLayer ("中心线")
  Layer = LyrMgr.AddLayer("中心线", "中心线", 255, 2, 0) '指定顏色
  LyrMgr.DeleteLayer ("文字")
  Layer = LyrMgr.AddLayer("文字", "文字", RGB(0, 0, 0), 0, 0) '指定顏色
  LyrMgr.DeleteLayer ("符号")
  Layer = LyrMgr.AddLayer("符号", "符号", RGB(0, 0, 0), 0, 0) '指定顏色

  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.Color = -1
         swAnn.Layer = toLayer1
         Set swDispDim = swDispDim.GetNext3
      Wend

      Set swCtrMark = swView.GetFirstCenterMark
      While Not swCtrMark Is Nothing
         Set swAnn = swCtrMark.GetAnnotation
         swAnn.Color = -1
         swAnn.Layer = toLayer2
         Set swCtrMark = swCtrMark.GetNext
      Wend

      Set swCenterLine = swView.GetFirstCenterLine
      While Not swCenterLine Is Nothing
         Set swAnn = swCenterLine.GetAnnotation
         swAnn.Color = -1
         swAnn.Layer = toLayer2
         Set swCenterLine = swCenterLine.GetNext
      Wend

      Set swNote = swView.GetFirstNote
      While Not swNote Is Nothing
         Set swAnn = swNote.GetAnnotation
         swAnn.Color = -1
         swAnn.Layer = toLayer3
         Set swNote = swNote.GetNext
      Wend

   Set swWeldSymbol = swView.GetFirstWeldSymbol
      While Not swWeldSymbol Is Nothing
         Set swAnn = swWeldSymbol.GetAnnotation
         swAnn.Color = -1
         swAnn.Layer = toLayer4
         Set swWeldSymbol = swWeldSymbol.GetNext
      Wend

      Set swSFSymbol = swView.GetFirstSFSymbol
      While Not swSFSymbol Is Nothing
         Set swAnn = swSFSymbol.GetAnnotation
         swAnn.Color = -1
         swAnn.Layer = toLayer4
         Set swSFSymbol = swSFSymbol.GetNext
      Wend

   Set swAnnDatumTag = swView.GetFirstDatumTag
      While Not swAnnDatumTag Is Nothing
         Set swAnn = swAnnDatumTag.GetAnnotation
         swAnn.Color = -1
         swAnn.Layer = toLayer4
         Set swAnnDatumTag = swAnnDatumTag.GetNext
      Wend


   Set swAnnDatumTargetSym = swView.GetFirstDatumTargetSym
      While Not swAnnDatumTargetSym Is Nothing
         Set swAnn = swAnnDatumTargetSym.GetAnnotation
         swAnn.Color = -1
         swAnn.Layer = toLayer4
         Set swAnnDatumTargetSym = swAnnDatumTargetSym.GetNext
      Wend



      Set swView = swView.GetNextView
Wend
swDraw.SheetNext
Dim swLayerMgr As Object
Dim swLayer As Object
Set swLayerMgr = swModel.GetLayerManager
swLayerMgr.SetCurrentLayer ("")
  Next i
  SheetName = swDraw.GetSheetNames
  swDraw.ActivateSheet SheetName(0)
End Sub

AutoLayer.rar

（53 KB, 下载次数: 163 ）

作者: Allate 时间: 2022-8-30 13:29

arter_2006 发表于 2022-8-26 18:42
请教一下，下面两句该如何写？谢谢！
选取顶层的装配体，
选择所有隐藏的零部件（相当于过滤选择中的“ ...

选取顶层的装配体这是有什么操作呢？估计是要用到GetRootComponent吧。

选择隐藏的零部件，这个可以先获取所有的零部件，然后使用循环判断每个零部件的状态，然后把状态是隐藏的选择起来就好。

作者: arter_2006 时间: 2022-8-31 08:43

Allate 发表于 2022-8-30 13:29
选取顶层的装配体这是有什么操作呢？估计是要用到GetRootComponent吧。

选择隐藏的零部件，这个可以先 ...

感谢指点！

作者: 深情的西瓜 时间: 2022-9-21 19:31
楼主很专业，写得很好！

作者: fenzhi 时间: 2023-3-10 15:32
感谢楼主分享，很不错！

作者: simpleye 时间: 2023-10-4 08:15
下载失败~~~~

作者: 沉默的人 时间: 2023-10-4 19:47
感谢楼主分享，很不错！

作者: 随遇而安9528 时间: 2023-11-15 19:43
楼主太有才了，膜拜中……

作者: zzm5337 时间: 2023-11-23 10:58
SW机械工程师网，找到组织了！

作者: zzm5337 时间: 2023-11-23 10:59
楼主太有才了，膜拜中……

作者: Ethan_Li 时间: 2024-1-14 22:38
谢谢楼主，试了一下，很好用。

作者: 3869 时间: 2024-1-20 11:05
好好学习，天天向上！

作者: 随遇而安9528 时间: 2024-2-20 11:08
感谢楼主分享，很不错！

作者: xiaoxiaolove 时间: 2024-3-29 12:24

有没有知道的大侠

作者: 15079678574 时间: 2024-4-7 14:49
做工程模板的时候就连接好属性，再保存为模板

作者: 董东咚 时间: 2024-4-10 13:04

作者: 13650987636 时间: 2024-4-12 16:17
SW机械工程师网，找到组织了！

欢迎光临 SolidWorks机械工程师网——最大的SolidWorks学习平台 (https://www.swbbsc.com/)