• vig11
  • Восстановленный участник
  • На форуме с 10 декабря 2004г.
  • Сообщений: 79
  • Спасибо: 0

Тема: Как собрать из чертежа в Selection set только линии определённой длины.

Как собрать из чертежа в Selection set только линии определённой длины.

  • Sigma
  • Восстановленный участник
  • На форуме с 1 июня 2004г.
  • Сообщений: 62
  • Спасибо: 0

Re: Как собрать из чертежа в Selection set только линии определённой длины.

А в чем проблема? Объект типа Line имеет свойство Length, вот и проверяйте для каждой линии, та это длина или нет

  • cadhelp
  • Восстановленный участник
  • На форуме с 24 февраля 2004г.
  • Сообщений: 231
  • Спасибо: 0

Re: Как собрать из чертежа в Selection set только линии определённой длины.

К сожалению ничего другого предложить не могу

Sub a()
Dim ss As AcadSelectionSet
Dim arrToRemove() As AcadEntity
Dim i As Integer
Set ss = ThisDrawing.ActiveSelectionSet
ss.SelectOnScreen 'Не забудь добавить фильтр для линий
i = 0
For Each line In ss 'Проход по всем линиям
'Для приведения дебильного VBA в чувство
LineLength = CDbl(Format(line.Length, ".000000"))
'Вместо 49.999999999875 получаем нормальные 50
If LineLength <> 50 Then
    ReDim Preserve arrToRemove(0 To i)
    Set arrToRemove(i) = line
    i = i + 1
End If
Next
If i > 0 Then ss.RemoveItems arrToRemove
End Sub

  • vig11
  • Восстановленный участник
  • На форуме с 10 декабря 2004г.
  • Сообщений: 79
  • Спасибо: 0

Re: Как собрать из чертежа в Selection set только линии определённой длины.

> Sigma
Каждый обьект я проверять могу, только если обьектов этих примерно 45 тысяч займёт это много времени. Вот и хотел избежать этого.

  • vig11
  • Восстановленный участник
  • На форуме с 10 декабря 2004г.
  • Сообщений: 79
  • Спасибо: 0

Re: Как собрать из чертежа в Selection set только линии определённой длины.

> cadhelp
Примерно так я и сделал. А почему Ты на e-mail-ы не отвечаешь?

  • cadhelp
  • Восстановленный участник
  • На форуме с 24 февраля 2004г.
  • Сообщений: 231
  • Спасибо: 0

Re: Как собрать из чертежа в Selection set только линии определённой длины.

Ya ego prochitat' ne mogu

  • Leonid
  • Восстановленный участник
  • На форуме с 16 июня 2003г.
  • Сообщений: 389
  • Спасибо: 0

Re: Как собрать из чертежа в Selection set только линии определённой длины.

> cadhelp
А зачем столько раз переопределять массив?
Удобнее это сделать один раз:

ReDim arrToRemove(0 To ss.Count)
For Each line In ss
LineLength = CDbl(Format(line.Length, ".000000"))
If LineLength <> 50 Then
    Set arrToRemove(i) = line
    i = i + 1
End If
Next
If i > 0 Then ss.RemoveItems arrToRemove

  • cadhelp
  • Восстановленный участник
  • На форуме с 24 февраля 2004г.
  • Сообщений: 231
  • Спасибо: 0

Re: Как собрать из чертежа в Selection set только линии определённой длины.

Я точно не помню, но кажется если массив arrToRemove содержит пустые поля или обьекты которые уже были удалены или еще какую грязь, то метод RemoveItems фатально грохается

  • Leonid
  • Восстановленный участник
  • На форуме с 16 июня 2003г.
  • Сообщений: 389
  • Спасибо: 0

Re: Как собрать из чертежа в Selection set только линии определённой длины.

> cadhelp
Правда ваша - не любит RemoveItems пустых полей в arrToRemove, но если время выполнения является критическим параметром

займёт это много времени

, то стОит побороться за его экономию:

Dim ss As AcadSelectionSet
     Dim arrToRemove() As AcadEntity
     Dim Entity As AcadEntity
     Dim i As Integer
     Dim Condition As Boolean 'условие отбора
     Set ss = ThisDrawing.SelectionSets.Add("MySet12")
     ss.SelectOnScreen
     ReDim arrToRemove(ss.Count)
     i = 0
     For Each Entity In ss
          If (Condition) Then
               Set arrToRemove(i) = Entity
               i = i + 1
          End If
     Next Entity
     i = i - 1
     ReDim Preserve arrToRemove(0 To i)
     ss.RemoveItems arrToRemove