Макрос Solidworks находит и заменяет на каждом листе чертежа

У меня есть некоторый опыт работы с VBA, и я ненавижу выполнять одну и ту же задачу 100 раз. Мне часто приходится делать чертежи Solidworks, эти чертежи представляют собой шаблоны, которые в основном представляют собой просто таблицы, которые я заполняю данными. На каждом листе в файле нужно изменить 3 вещи (от листа 3 до последнего листа). Обычно я захожу на каждый лист и делаю 3 поиска и замены, чтобы изменить каждый лист. затем перейдите к следующему листу и повторите.

Мой план состоял в том, чтобы код подсчитывал количество листов, запрашивал у пользователя первый поиск/замену, заменял этот текст на всех листах, затем повторял для второй замены и снова для третьей. Я записал макрос и добавил некоторый код, но я продолжаю получать ошибки времени выполнения (в коде ниже). Ни один макрос, который я записал, никогда не давал мне столько ошибок, если вы можете, пожалуйста, помогите

Dim swApp As SldWorks.SldWorks
Dim swmodel As SldWorks.ModelDoc2
Dim swdraw As SldWorks.DrawingDoc
Dim Part As Object
Dim Otext As String
Dim Ntext As String
Dim Smax As Integer
Dim i As Integer
Dim swSheet As SldWorks.Sheet
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

Sub main()
Set swApp = Application.SldWorks
Set swmodel = swApp.ActiveDoc
 'Set swSheet = swdraw.GetCurrentSheet

Smax = instance.GetSheetCount() - 3   ' runtime 424 error here
Set swSheet = swdraw.GetCurrentSheet  ' runtime 91 error if i skip the line above

Otext = Application.InputBox("find this text")
Ntext = Application.InputBox("find this text")

For i = 1 To Smax

Set Part = swApp.ActiveDoc
'--------------------Find and Replace Annotations--------------------
Set swUtil = swApp.GetAddInObject("Utilities.UtilitiesApp")
Set swUtilFindReplaceAnnotations = swUtil.FindReplaceAnnotations
longstatus = swUtilFindReplaceAnnotations.InitPMPage()
'--------------------Block Recording--------------------
#If 0 Then
#End If
'--------------------UnBlock Recording------------------
swUtilFindReplaceAnnotations.FindText = Otext
swUtilFindReplaceAnnotations.ReplaceText = Ntext
swUtilFindReplaceAnnotations.options = gtFraMatchCase
swUtilFindReplaceAnnotations.AnnotationFilter = gtFraAllTypes
Part.ClearSelection2 True
Part.ClearSelection2 True
Part.ClearSelection2 True
Part.ClearSelection2 True
Part.ClearSelection2 True
longstatus = swUtilFindReplaceAnnotations.ReplaceAll()
'--------------------Block Recording--------------------
#If 0 Then
#End If
'--------------------UnBlock Recording------------------
longstatus = swUtilFindReplaceAnnotations.Close()
Part.SheetNext
Part.ViewZoomtofit2

Next i

End Sub

loops macros find replace solidworks
person Alberto Brown    schedule 05.07.2016    source источник
comment
что такое экземпляр? Вроде не декларируется. swdraw также никогда не объявляется.   -  person AndrewK    schedule 06.07.2016
comment
это было с другого форума, где объяснялось, как заставить Solidworks подсчитывать количество листов в чертеже. в примере он не был определен, просто использовался.   -  person Alberto Brown    schedule 06.07.2016

Ответы (1)


arrow_upward
2
arrow_downward

Это должно сработать. Однако для каждого листа появится всплывающее окно об успешном завершении, поскольку именно так работает утилита поиска и замены SOLIDWORKS.

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDrawingDoc As SldWorks.DrawingDoc
Dim vSheetNames As Variant
Dim longstatus As Long

Sub main()

    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swDrawingDoc = swModel
    vSheetNames = swDrawingDoc.GetSheetNames
    Otext = InputBox("find this text")
    Ntext = InputBox("find this text")

    For i = 0 To UBound(vSheetNames)
        swDrawingDoc.ActivateSheet (vSheetNames(i))
        Set swUtil = swApp.GetAddInObject("Utilities.UtilitiesApp")
        Set swUtilFindReplaceAnnotations = swUtil.FindReplaceAnnotations
        longstatus = swUtilFindReplaceAnnotations.InitPMPage()
        swUtilFindReplaceAnnotations.FindText = Otext
        swUtilFindReplaceAnnotations.ReplaceText = Ntext
        swUtilFindReplaceAnnotations.Options = gtFraWholeWord
        swUtilFindReplaceAnnotations.AnnotationFilter = gtFraAllTypes
        longstatus = swUtilFindReplaceAnnotations.ReplaceAll()
        longstatus = swUtilFindReplaceAnnotations.Close()
    Next i

End Sub
person AndrewK    schedule 06.07.2016
comment
У меня его нет, смотрю только лист 3 и далее здесь, хотя - person AndrewK; 06.07.2016
comment
возможно, просто возьмите For i = 0 To UBound(vSheetNames) и измените его на For i = 2 To UBound(vSheetNames) и оберните его вокруг оператора if, убедившись, что существует более 3 листов - person AndrewK; 06.07.2016
comment
спасибо, Эндрюк, однако теперь я получаю время выполнения 91 в этой строке Set swUtilFindReplaceAnnotations = swUtil.FindReplaceAnnotations я буду продолжать копать, но это уже шаг в правильном направлении - person Alberto Brown; 06.07.2016
comment
Какая версия солидворкс? Я использовал 2015 для тестирования. Также убедитесь, что в коде нет Option Explicit. Это приведет к ошибке с этим набором. - person AndrewK; 06.07.2016
comment
Солидворкс 2011 x64. Я не верю, что есть явный вариант, но я еще раз проверю и попробую еще раз. - person Alberto Brown; 06.07.2016
comment
Я мог проверить только до 2014 года. 2011 год довольно старый, и я ищу все слово. Если вы хотите найти часть, измените параметры на что-то другое. - person AndrewK; 06.07.2016