公差标注移层设色成功,为何还报错?
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
不能成功解压啊。 本帖最后由 arter_2006 于 2022-8-11 14:08 编辑
注:从新下载后把后缀改成swp,或直接复制上面的代码。
页:
[1]