• На форуме с 29 января 2009г.
  • Сообщений: 7
  • Спасибо: 0

Тема: Как зуммировать объкт?

Может и глупо ... Есть приложение на VB5 , подключаюсь к Асаду, открываю опред dwg, нужно осуществить обычный поиск Текстового объкта(с указанным текстом) и зумировать его , короче как в меню Правка->найти .
Вот кусок из программы

Dim objSelSet As AcadSelectionSet
 Dim objSelCol As AcadSelectionSets
 Dim objText   As AcadText
 Dim intType(0) As Integer
 Dim varData(0) As Variant
 Set objSelCol = acadDoc.SelectionSets
   For Each objSelSet In objSelCol
     If objSelSet.Name = "txtoa" Then
         objSelCol.Item("txtoa").Delete
              Exit For
      End If
   Next objSelSet
Set objSelSet = objSelCol.Add("txtoa")
intType(0) = 0
varData(0) = "TEXT"
objSelSet.Select acSelectionSetAll, filtertype:=intType, filterdata:=varData
    For Each objText In objSelSet
         If objText.TextString = n_reg Then
                    'MsgBox objText.TextString
                    f_find = True
                     Exit For
          End If
      Next objText
     If f_find = False Then
         MsgBox "Указанный " & n_reg & " ненайден!!!",vbInformation, "Внимание!"
     Else

           'ура нашли то что искали
           'а теперь как зумировать как в поиске
Или может , кто знает как это найти код этого меню(Поиск)??????    Ну поможите мне бедной, асад совсем не знаю . Пишу на VB

  • На форуме с 29 января 2009г.
  • Сообщений: 7
  • Спасибо: 0

Re: Как зуммировать объкт?

извиняюсь вот код

Dim objSelSet As AcadSelectionSet
Dim objSelCol As AcadSelectionSets
Dim objText As AcadText
Dim intType(0) As Integer
Dim varData(0) As Variant
Set objSelCol = acadDoc.SelectionSets
For Each objSelSet In objSelCol
If objSelSet.Name = "txtoa" Then
objSelCol.Item("txtoa").Delete
Exit For
End If
Next objSelSet
Set objSelSet = objSelCol.Add("txtoa")
intType(0) = 0
varData(0) = "TEXT"
objSelSet.Select acSelectionSetAll, filtertype:=intType, filterdata:=varData
For Each objText In objSelSet
If objText.TextString = n_reg Then
'MsgBox objText.TextString
f_find = True
Exit For
End If
Next objText
If f_find = False Then
MsgBox "Указанный " & n_reg & " ненайден!!!",vbInformation, "Внимание!"
Else

'ура нашли то что искали
'а теперь как зумировать как в поиске

  • fixo
  • Восстановленный участник
  • На форуме с 3 июля 2008г.
  • Сообщений: 217
  • Спасибо: 0

Re: Как зуммировать объкт?

> KROXA
Типа

....
For Each objText In objSelSet
If objText.TextString = n_reg Then
'MsgBox objText.TextString
dim hndl as string
hndl = objtext.handle
f_find = True
Exit For
End If
Next objText
Thisdrawing.sendcommand "_zoom OB " & "(handent " & chr(34) & hndl & chr(34) & ")" & vbcr & vbcr
.....

~'J'~

  • На форуме с 29 января 2009г.
  • Сообщений: 7
  • Спасибо: 0

Re: Как зуммировать объкт?

так не подходит , асад требует ввести
в командную строку .... . Юзера это не устраивает , нада программно описать функцию зумировать, как в меню правка-поиск-зумировать, Чтоб юзер просто увидел найденный объект, при этом никуда нелазая

  • fixo
  • Восстановленный участник
  • На форуме с 3 июля 2008г.
  • Сообщений: 217
  • Спасибо: 0

Re: Как зуммировать объкт?

> KROXA
Тогда звлекай координаты BoundingBox
этого объекта и потом делай ZoomWindow
~'J'~

  • На форуме с 29 января 2009г.
  • Сообщений: 7
  • Спасибо: 0

Re: Как зуммировать объкт?

objText.GetBoundingBox(MinPoint, MaxPoint)

не получается у меня координаты извлечь, найденного objText?

  • На форуме с 12 февраля 2009г.
  • Сообщений: 26
  • Спасибо: 0

Re: Как зуммировать объкт?

...
Dim MinPoint As Variant, MaxPoint As Variant
...
objText.GetBoundingBox MinPoint, MaxPoint
ZoomWindow MinPoint, MaxPoint
...