Удаление слоёв в чертеже

[fox1001 787]

дарова, коллеги.

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

может кто-нить помочь?

[kobold 0]

Попробуй через менеджер слоев, объявить его надо как SldWorks.LayerMgr, у него есть метод DeleteLayer("Имя слоя").

В справке SW API можно посмотреть пример по работе со слоями, поищи по словам Get Layers Example и описание метода DeleteLayer Method

[fox1001 787]

создал форму, на форму влепил кнопку, в коде кнопки пишу:

Private Sub CommandButton1_Click()
Dim instance As SldWorks.LayerMgr
Dim Name As String
Dim value As Boolean

Name = "asd100"
Set value = instance.AddLayer(Name)

End Sub

запускаю выдает ошибку. подскажите как надо правильно сделать?

[kobold 0]

Я думал вам надо слои удалять а не добавлять.

А ошибка выскакиевает из за того что функция должна получать пять аргументов, а у вас только один, и возвращаемое значение у нее не bool а int

вот описание из справки

Function AddLayer( _

ByVal NameIn As String, _

ByVal DescIn As String, _

ByVal ColorIn As Integer, _

ByVal StyleIn As Integer, _

ByVal WidthIn As Integer _

) As Integer

[fox1001 787]

вы всё правильно думали, удалять мне нужно. я ведь правильно понимаю, что для удаления нужен только один аргумент - имя слоя. вместо "AddLayer" пишу "DeleteLayer" запускаю выдает ошибку.

[Shvg 67]

вы всё правильно думали, удалять мне нужно. я ведь правильно понимаю, что для удаления нужен только один аргумент - имя слоя. вместо "AddLayer" пишу "DeleteLayer" запускаю выдает ошибку.

Ваша процедура должна выглядеть примерно так:

Private Sub CommandButton1_Click()

	On Error GoTo LineError



	Dim swApp As SldWorks.SldWorks

	Set swApp = GetObject("", "SldWorks.Application")

	Dim swModel As SldWorks.ModelDoc2

	Set swModel = swApp.ActiveDoc

	

	If swModel Is Nothing Then Exit Sub

	

	If swModel.GetType() <> swDocDRAWING Then

		Exit Sub

	End If

	

	Dim swLayerMgr As SldWorks.LayerMgr

	Set swLayerMgr = swModel.GetLayerManager

	

	Dim nameLayer As String

	nameLayer = "asd100"

	

	' Может нужна будет проверка на наличие этого слоя

	swLayerMgr.DeleteLayer (nameLayer)

	

	Exit Sub

	

LineError:

	  

End Sub

[fox1001 787]

ой спасиииииииииибки

щаз я уже дома и солида под рукой нету. а завтра с утра будет мне щасьтье

пасиба всем за помощь. если не получится буду вас снова вопросами донимать

[fox1001 787]

Shvg огромное спасибо. все работает ОТЛИЧНО!!!