求自动将相关标注移动到指定的图层

arter_2006

求一宏，将指定的标注内容移动到指定的图层，如：
尺寸标注——移动到——尺寸图层
符号标注，如基准符号、加工符号服、粗糙度符号、焊接符号移动到——符号图层
技术要求、材料明细表移动到——文字层

arter_2006

有没有知道的大侠

arter_2006

顶一下，坐等高手！

arter_2006

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

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

arter_2006

   经典案例图书

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

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

arter_2006

下载后把文件后缀.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

arter_2006

   经典案例图书

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

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

感谢指点！