Макрос для Sw

[Игорь 3]

Коллеги!!!

Задача - пакетом перезаписать открытые файлы чертежей как отсоединенные чертежи и закрыть их. Есть такая команда swSaveAsDetachedDrawing но чего то не работает... Помогите, пожалуйста.

[Nikolas 0]

RapidDraft чтоли хочешь?

запись макроса делал? посмотри что там используется (какая функция или процедура) и подредактируй для пакетной обработки...

[Игорь 3]

Да, RapidDraft.

Но по-простому не получается. Перезаписывать не хочет под тем же именем, а если перезаписывает, то связи не отрывает. И в хелпе по API как-то смутно.

[Lyvra 0]

Здрям

макрос нужен?

Call Part.SaveAs4("detach.SLDDRW", swSaveAsDetachedDrawing, _

swSaveAsOptions_DetachedDrawing And swSaveAsOptions_Silent And swSaveAsOptions_Copy , nErr, nWrn)

[Игорь 3]

Nikolas

Lyvra

Вот на второй день успехи, если не затруднит, подскажите - не хочет закрывать оригинальный док после конвертации и как бы это зациклить на все открытые чертежи?

Sub main()

Set swApp = Application.SldWorks

Set Part = swApp.ActiveDoc

sPathName = Part.GetPathName

sPathName = Left(sPathName, Len(sPathName) - 7)

sPathName = sPathName + " .slddrw"

Part.ViewZoomtofit2

Part.SaveAs2 sPathName, 4, True, False

Part.EditSketch

Set Part = Nothing

swApp.CloseDoc ""

End Sub

Изменено 21 мая 2004 пользователем Игорь

[Lyvra 0]

Здрям

Set Part = swApp.ActiveDoc

Do While Not (Part Is Nothing)

sPath = Part.GetPathName

' делаем свое темное дело

swApp.CloseDoc (sPath) ' нужен путь в этой функции!

Set Part = swApp.ActiveDoc

Loop

[Игорь 3]

Lyvra

как бы энтот макрос присобачить?

Sub main()

Set swApp = Application.SldWorks

Set Part = swApp.ActiveDoc

partTitle = Part.GetTitle

Set Part = Nothing

swApp.CloseDoc partTitle

End Sub

PS знакомлюсь с макросами второй день

[Игорь 3]

Ну вот, кому надо - берите

Sub main()

Dim swApp As Object

Dim Part As Object

Dim sPathName As String

Dim PT As String

Set swApp = Application.SldWorks

Set Part = swApp.ActiveDoc

Do While Not (Part Is Nothing)

sPathName = Part.GetPathName

sPathName = Left(sPathName, Len(sPathName) - 7)

sPathName = sPathName + " .slddrw"

Part.ViewZoomtofit2

Part.SaveAs2 sPathName, 4, True, False

PT = Part.GetTitle

swApp.CloseDoc PT

Set Part = swApp.ActiveDoc

Loop

End Sub

[nick_le 0]

Прошу помощи в написании макроса для сохранения в DWG

Макрос записался, но при записи пишет везде одно и тоже имя и кладет в одну и туже папку, как его заставить писать имя и путь сохраняемого файла?

Dim Part As Object

Dim boolstatus As Boolean

Dim longstatus As Long, longwarnings As Long

Sub main()

Set swApp = _

Application.SldWorks

Set Part = swApp.ActiveDoc

Part.SheetPrevious

boolstatus = Part.EditRebuild3()

Part.ViewZoomtofit2

longstatus = Part.SaveAs3("D:\ТУТ УКАЗЫАЕТ ПУТЬ И ИМЯ.DWG", 0, 0)

End Sub

[nick_le 0]

у нас требование создавать копию чертежа в двг...

вопщем, мы тут поковырялись и этот макрос замутили

теперь совмещаем его с SaveAsPDF. пока безуспешно

[nick_le 0]

если имеется в виду, сохранить как dwg, то это слишком долго и муторно, ведь надо сохранить каждый чертеж.

других стандартных средств я не знаю, по-этому захотел создать макрос