Список форумов Конференция САПР Bentley MicroStation Конференция САПР Bentley MicroStation
www.ustation.ru
 
 FAQFAQ   ПоискПоиск   ПользователиПользователи   ГруппыГруппы   РегистрацияРегистрация 
 ПрофильПрофиль   Войти и проверить личные сообщенияВойти и проверить личные сообщения   ВходВход 

Удаление неиспользуемых в чертеже наборов TagSets

 
Начать новую тему   Ответить на тему    Список форумов Конференция САПР Bentley MicroStation -> Прикладное
Предыдущая тема :: Следующая тема  
Автор Сообщение
ivsem



Зарегистрирован: 01.02.2006
Сообщения: 63
Откуда: Киев

СообщениеДобавлено: Сб Сен 12, 2009 4:25 pm    Заголовок сообщения: Удаление неиспользуемых в чертеже наборов TagSets Ответить с цитатой

Получили от смежников десятки чертежей с огромным колличеством
не используемых в чертежех наборов TagSets.
Ручное удаление занимает очень много времени.
Нужно писать программку. Но я "программист-любитель", пишу небольшие программки на "процедурном" старом ALisp для Acad.
Сейчас сижу разбираюсь с "обьектно-ориентированным" VBA MicroStation. Но чувствую "песня долгая". Может, кто поможет?.
С уважением, дядя Ваня


Последний раз редактировалось: ivsem (Пн Сен 14, 2009 11:12 am), всего редактировалось 3 раз(а)
Вернуться к началу
Посмотреть профиль Отправить личное сообщение
ivsem



Зарегистрирован: 01.02.2006
Сообщения: 63
Откуда: Киев

СообщениеДобавлено: Вс Сен 13, 2009 1:09 pm    Заголовок сообщения: Ответить с цитатой

И так есть первые подвижки.
Sub AAA ()
Application.ActiveDesignFile.TagSets.Remove ("NameTagSet")
End Sub
Программка удаляет из чертежа TagSet c названием - NameTagSet
Если тагого TagSet в чертеже нет, возвращается код ошибки.

Теперь надо добыть из чертежа имена наборов TagSets
Вернуться к началу
Посмотреть профиль Отправить личное сообщение
ivsem



Зарегистрирован: 01.02.2006
Сообщения: 63
Откуда: Киев

СообщениеДобавлено: Вс Сен 13, 2009 7:27 pm    Заголовок сообщения: Ответить с цитатой

Ковыряюсь дальше...
Удалось собрать в массив имена всех TagSet из чертежа
Sub BBB()
Dim I As Integer
Dim oCount As Integer
Dim MassivTagSet() As String
Dim oTagSet As TagSet
'Подсчитаем количество TagSet в чертеже
oCount = Application.ActiveDesignFile.TagSets.Count
'Переопределим Массив под количество TagSet
ReDim MassivTagSet(0 To oCount)

I = 0
'Использовано великое и могучее заклинание For Each !
For Each oTagSet In ActiveDesignFile.TagSets
MassivTagSet(I) = oTagSet.Name
'Посмотрим в окне "Immediate", что в массиве
Debug.Print MassivTagSet(I) ' В нем все имена TagSet
I = I + 1
Next

End Sub


Последний раз редактировалось: ivsem (Пн Сен 14, 2009 11:44 am), всего редактировалось 1 раз
Вернуться к началу
Посмотреть профиль Отправить личное сообщение
Leonid
давно здесь сидим


Зарегистрирован: 28.01.2006
Сообщения: 598
Откуда: С.-Петербург

СообщениеДобавлено: Пн Сен 14, 2009 9:19 am    Заголовок сообщения: Ответить с цитатой

Судя по всему, все-таки решили использовать восьмерку?
"Пгавильным путем идете, товагищи!"
Вернуться к началу
Посмотреть профиль Отправить личное сообщение Отправить e-mail
ivsem



Зарегистрирован: 01.02.2006
Сообщения: 63
Откуда: Киев

СообщениеДобавлено: Пн Сен 14, 2009 11:35 am    Заголовок сообщения: Ответить с цитатой

Да будем использовать MS8. Тем более. что есть лицензионные
программы MS8 валяющиеся без дела.
Я немного поковырял встроенный в MS7 BASIC.
Редактор очень примитивный. Сам язык практически не имеет
средств для работы с офисом. Почему в MS под виндовс сразу не был
встроем VBA загадка не для средних умов.
Так что продолжаю ковырять VBA, жаль времени маловато, текучка заедает.
Вернуться к началу
Посмотреть профиль Отправить личное сообщение
ivsem



Зарегистрирован: 01.02.2006
Сообщения: 63
Откуда: Киев

СообщениеДобавлено: Вт Сен 15, 2009 10:19 am    Заголовок сообщения: Ответить с цитатой

Теперь попробуем получить имена только присоединенных TagSet
Код:

Sub CCC()
Dim I As Integer
Dim MassivTagSetAttaching(0 To 1000) As String
Dim oTag As TagElement
Dim oElemEnum As ElementEnumerator

CadInputQueue.SendCommand "CHOOSE ALL "
Set oElemEnum = Application.ActiveModelReference.GetSelectedElements
I = 0
While oElemEnum.MoveNext
 Select Case oElemEnum.Current.Type
  Case MsdElementType.msdElementTypeTag
  Set oTag = oElemEnum.Current
   If oTag Is Nothing = False Then
       MassivTagSetAttaching(I) = oTag.TagSetName
       Debug.Print MassivTagSetAttaching(I)
   I = I + 1
   End If
 End Select
Wend
CadInputQueue.SendCommand "CHOOSE NONE "
End Sub

В MassivTagSetAttaching сбрасывается большое количество повтояющихся имен TagSet. Надо будет как-то побороть это.


Последний раз редактировалось: ivsem (Ср Сен 16, 2009 8:30 pm), всего редактировалось 1 раз
Вернуться к началу
Посмотреть профиль Отправить личное сообщение
beer



Зарегистрирован: 01.02.2006
Сообщения: 215
Откуда: Москва

СообщениеДобавлено: Ср Сен 16, 2009 8:52 am    Заголовок сообщения: Ответить с цитатой

Все гораздо проще
Код:

Sub beer()
    Dim i As Integer
    i = 0
    Do While i < ActiveDesignFile.TagSets.Count
        If ActiveDesignFile.TagSets(i + 1).Name <> "Набор который надо оставить" Then
            ActiveDesignFile.TagSets.Remove (i + 1)
        else
            i = i + 1
        end if
    Loop
End Sub
Вернуться к началу
Посмотреть профиль Отправить личное сообщение Отправить e-mail
ivsem



Зарегистрирован: 01.02.2006
Сообщения: 63
Откуда: Киев

СообщениеДобавлено: Ср Сен 16, 2009 4:47 pm    Заголовок сообщения: Ответить с цитатой

Прекраcно работающая ВТОРАЯ часть программы от beer
Код:
Sub beer()
    Dim i As Integer
    Dim MassivTagSet() As String
    oCount = Application.ActiveDesignFile.TagSets.Count
    ReDim MassivTagSet(0 To oCount)

   'To, что должно остаться в чертеже (первая часть программы)
    MassivTagSet(0) = "piket_s"
    MassivTagSet(1) = "point_s"
    MassivTagSet(2) = "XXX"
    MassivTagSet(3) = "УУУ"
  '......  и т. п.  прикрепленные TagSet  ...................

  ' вторая часть программы
    i = 0
    Do While i < ActiveDesignFile.TagSets.Count
        If ActiveDesignFile.TagSets(i + 1).Name <> MassivTagSet(i) Then
            ActiveDesignFile.TagSets.Remove (i + 1)
        Else
            i = i + 1
        End If
    Loop
End Sub


Большое спасибо!!!

Но остается пока нерешенной ПЕРВАЯ часть программы в которой
надо собрать программно из ИСПОЛЬЗУЕМЫХ в чертеже TagSet
массив MassivTagSet.

Конечная цель сией "разработки":
Удалить НЕИСПОЛЬЗУЕМЫЕ в чертеже TagSet
Жаль, что нет свойства TagSet "прикреплен-неприкреплен"
Вернуться к началу
Посмотреть профиль Отправить личное сообщение
beer



Зарегистрирован: 01.02.2006
Сообщения: 215
Откуда: Москва

СообщениеДобавлено: Чт Сен 17, 2009 7:23 am    Заголовок сообщения: Ответить с цитатой

Стоп! Вы немножко переделали, что я написал а именно строку
Код:
If ActiveDesignFile.TagSets(i + 1).Name <> MassivTagSet(i) Then


Поверьте в таком варианте это будет работать не правильно!!!!
Вернуться к началу
Посмотреть профиль Отправить личное сообщение Отправить e-mail
beer



Зарегистрирован: 01.02.2006
Сообщения: 215
Откуда: Москва

СообщениеДобавлено: Чт Сен 17, 2009 7:56 am    Заголовок сообщения: Ответить с цитатой

Так будет правильнее
Код:


options base 0

Function TagSetUsed(TSets() As String, TSetName As String) As Boolean
    Dim i As Integer
    For i = 1 To UBound(TSets)
        If TSets(i) = TSetName Then
            TagSetUsed = True
            Exit Function
        End If
        TagSetUsed = False
    Next i
End Function


Sub beer()

    Dim sc As New ElementScanCriteria
    sc.ExcludeAllTypes
    sc.IncludeType (msdElementTypeTag)
   
    Dim ee As ElementEnumerator
    Set ee = ActiveModelReference.Scan(sc)
   
    Dim UsedTSets() As String
    ReDim UsedTSets(0)
   
    Do While ee.MoveNext
        If Not TagSetUsed(UsedTSets(), ee.Current.AsTagElement.TagSetName) Then
            ReDim Preserve UsedTSets(UBound(UsedTSets) + 1)
            UsedTSets(UBound(UsedTSets) ) = ee.Current.AsTagElement.TagSetName
        End If
    Loop
   
   

    Dim i As Integer
    i = 0
    Do While i < ActiveDesignFile.TagSets.Count
        If Not TagSetUsed(UsedTSets(), ActiveDesignFile.TagSets(i + 1).Name) Then
            ActiveDesignFile.TagSets.Remove (i + 1)
        Else
            i = i + 1
        End If
    Loop
End Sub


Но учтите, это будет правильно работать, только если в dgn файле только одна модель (что подходит для вашего случая, поскольку файлы в формате семерки). Для файлов с несколькими моделями надо будет еще сделать проход по всем моделям
Вернуться к началу
Посмотреть профиль Отправить личное сообщение Отправить e-mail
ivsem



Зарегистрирован: 01.02.2006
Сообщения: 63
Откуда: Киев

СообщениеДобавлено: Чт Сен 17, 2009 9:38 am    Заголовок сообщения: Ответить с цитатой

Уважаемый beer, написанная вами программа на тестовых примерах сработала правильно. Оставила в чертежах прикрепленные TagSet
и удалила неприкрепленные TagSet.
Ваша программа очень облегчит работу нашим дамам-камеральщицам.
Большое вам спасибо!!!
С уважением и восхищением, начинающий VBA "программист" дядя Ваня


Последний раз редактировалось: ivsem (Вс Сен 20, 2009 8:26 pm), всего редактировалось 2 раз(а)
Вернуться к началу
Посмотреть профиль Отправить личное сообщение
beer



Зарегистрирован: 01.02.2006
Сообщения: 215
Откуда: Москва

СообщениеДобавлено: Чт Сен 17, 2009 10:47 am    Заголовок сообщения: Ответить с цитатой

я еще и вышивать умею... и на машинке тоже... (с) Кот Матроскин Smile
Вернуться к началу
Посмотреть профиль Отправить личное сообщение Отправить e-mail
ivsem



Зарегистрирован: 01.02.2006
Сообщения: 63
Откуда: Киев

СообщениеДобавлено: Вс Сен 20, 2009 7:34 pm    Заголовок сообщения: Ответить с цитатой

Уважаемый beer, при запуске вашей программы компилятор останавливается на строке
options base 0 с сообщением Compile error: Expected: end of statement
Если эту сроку "заремить", то программа срабатывает нормально.
В чем может быть дело?
Вернуться к началу
Посмотреть профиль Отправить личное сообщение
beer



Зарегистрирован: 01.02.2006
Сообщения: 215
Откуда: Москва

СообщениеДобавлено: Вт Сен 22, 2009 2:04 pm    Заголовок сообщения: Ответить с цитатой

Эта строка указывает, что нумерация массивов начинается с нуля. Она ВСЕГДА должна быть в начале модуля
Вернуться к началу
Посмотреть профиль Отправить личное сообщение Отправить e-mail
ivsem



Зарегистрирован: 01.02.2006
Сообщения: 63
Откуда: Киев

СообщениеДобавлено: Пн Окт 05, 2009 8:47 am    Заголовок сообщения: Ответить с цитатой

Слегка доработанная программа Beer
Добавлен вывод в статусную строку (что бы пользователь видел что программа работает) и в конце вывод результатов работы в MsgBox
Код:
Option Explicit
'options base 0

Function TagSetUsed(TSets() As String, TSetName As String) As Boolean
    Dim i As Double
    For i = 1 To UBound(TSets)
        If TSets(i) = TSetName Then
            TagSetUsed = True
            Exit Function
        End If
        TagSetUsed = False
    Next i
End Function


Sub Beer()
    Dim j As Double
    Dim oTagSetAll As Double
    Dim oTagSetPrisoed As Double
    Dim oStroka As String
    Dim i As Double
    Dim k As Double
    Dim sc As New ElementScanCriteria
    sc.ExcludeAllTypes
    sc.IncludeType (msdElementTypeTag)
    Dim ee As ElementEnumerator
    Set ee = ActiveModelReference.Scan(sc)
    Dim UsedTSets() As String
    ReDim UsedTSets(0)
    k = 0
    Do While ee.MoveNext
        If Not TagSetUsed(UsedTSets(), ee.Current.AsTagElement.TagSetName) Then
            ReDim Preserve UsedTSets(UBound(UsedTSets) + 1)
            UsedTSets(UBound(UsedTSets)) = ee.Current.AsTagElement.TagSetName
        End If
        k = k + 1
        ShowStatus "Выполнено: " & CStr(k)
    Loop
    i = 0
    j = 0
    k = 0
    oTagSetAll = ActiveDesignFile.TagSets.Count
    Do While i < ActiveDesignFile.TagSets.Count
        If Not TagSetUsed(UsedTSets(), ActiveDesignFile.TagSets(i + 1).Name) Then
            ActiveDesignFile.TagSets.Remove (i + 1)
            j = j + 1
        Else
            i = i + 1
        End If
        k = k + 1
        ShowStatus "Удаляю неиспользуемые TagSet: " & CStr(j)
    Loop
       oTagSetPrisoed = oTagSetAll - j
       oStroka = "Используемых_в_чертеже_TagSet=" & CStr(oTagSetPrisoed) _
                & "    Удалено_неиспользуемых_TagSet=" & CStr(j)
MsgBox (oStroka)
ShowStatus ""
End Sub
Вернуться к началу
Посмотреть профиль Отправить личное сообщение
Показать сообщения:   
Начать новую тему   Ответить на тему    Список форумов Конференция САПР Bentley MicroStation -> Прикладное Часовой пояс: GMT + 3
Страница 1 из 1

 
Перейти:  
Вы не можете начинать темы
Вы не можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете голосовать в опросах


Powered by phpBB © 2001, 2005 phpBB Group