arter_2006 发表于 2022-8-11 13:36:34

公差标注移层设色成功,为何还报错?

            Set swgtol = swgtol.GetNext

如下所示代码,能执行成功,但老是上面这句报错,请大侠指点,谢谢




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 swgtol As SldWorks.gtol




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, 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 swgtol = swView.GetFirstgtol
      While Not swgtol Is Nothing
            Set swAnn = swgtol.GetAnnotation
            swAnn.Color = -1
            swAnn.Layer = toLayer3
            Set swgtol = swgtol.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



鑫森淼炎垚 发表于 2022-8-11 13:58:03

不能成功解压啊。

arter_2006 发表于 2022-8-11 14:05:28

本帖最后由 arter_2006 于 2022-8-11 14:08 编辑


注:从新下载后把后缀改成swp,或直接复制上面的代码。
页: [1]
查看完整版本: 公差标注移层设色成功,为何还报错?