公差标注移层设色成功，为何还报错？

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,或直接复制上面的代码。

		自动登录	找回密码
密码			注册会员

公差标注移层设色成功，为何还报错？

本帖子中包含更多资源

本帖子中包含更多资源

本帖子中包含更多资源