Schöck
| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > VBA, как просканировать окружности на чертеже?

VBA, как просканировать окружности на чертеже?

Ответ
Поиск в этой теме
Непрочитано 11.04.2005, 12:54 #1
VBA, как просканировать окружности на чертеже?
basboy
 
Регистрация: 11.04.2005
Сообщений: 5

Мне нужно в VBA просканировать чертёжь и выделить группы окружностейб затем у определённой нруппы изменить свойства.

Вопрос в том, как добраться к окружностям на чертеже через VBA? Запрос на выбор примитива не очень подходит, т.к. предполагается, что на чертеже будет много окружностей.
Просмотров: 3502
 
Непрочитано 11.04.2005, 13:14
#2
{Smirnoff}

Инженер по системам безопасности
 
Регистрация: 23.11.2003
Рига
Сообщений: 1,099


Как то так:
Код:
[Выделить все]
Public Sub CirclesSelect(AcadDoc As AcadDocument)
Dim SelSetColl As AcadSelectionSets
Dim CirSet As AcadSelectionSet
Dim Item As AcadEntity
Dim FilterType(0 To 0) As Integer
Dim FilterData(0 To 0) As Variant

FilterType(0) = 0

FilterData(0) = "CIRCLE"

Set SelSetColl = AcadDoc.SelectionSets
Set CirSet = SelSetColl.Add("MySet")
CirtSet.Select acSelectionSetAll, , , FilterType, FilterData

For Each Item In CirSet

' Ваши действия с каждой окружностью
    
Next Item

CirSet.Delete
Set CirSet = Nothing
Set SelSetColl = Nothing

End Sub
{Smirnoff} вне форума  
 
Автор темы   Непрочитано 11.04.2005, 13:20
#3
basboy


 
Регистрация: 11.04.2005
Сообщений: 5
<phrase 1=


Спасибо, попробуем...
basboy вне форума  
 
Автор темы   Непрочитано 12.04.2005, 18:56
#4
basboy


 
Регистрация: 11.04.2005
Сообщений: 5
<phrase 1=


Fantomas, чё-то не покатил код. Мот я не правильно чё делаю.
Я вообще в VBA не проф.
Я так понимаю, что функцию нужно вызывать типо так: CirclesSelect ThisDrawing

Тогда компилятор ругается на строчку Set CirSet = SelSetColl.Add("MySet")

Меса такая:
"The named selection set exists"

При пошаговом компилировании видно, что после выполнения строчки Set SelSetColl = AcadDoc.SelectionSets переменная SelSetColl ничего не содержит.
basboy вне форума  
 
Непрочитано 12.04.2005, 19:52
#5
{Smirnoff}

Инженер по системам безопасности
 
Регистрация: 23.11.2003
Рига
Сообщений: 1,099


К вечеру запущу у себя, сейчас времени нет. Я это по быстрому в окне форума из другой процедуры переделал. Кстати посмотри, может у тебя там не то, потому что через несколько минут, я посмотрел нашел ошибки и исправил, а ты к тому времени уже мог скопировать. То на что он ругается это неуничтоженный по какой то причине набор "MySet" (Set CirSet = Nothing) , вообще название надо поменять, слишком тривиально и может повторятся вдругих прогах... Если действительно у тебя не иправленный листинг запускай в новом файле (в старом опять на дублирующиеся название набора ругнется), обработчик ошибок уничтожающий объекты в любом случае я допишу. В VBA тоже пока не профи...
{Smirnoff} вне форума  
 
Непрочитано 12.04.2005, 20:29
#6
{Smirnoff}

Инженер по системам безопасности
 
Регистрация: 23.11.2003
Рига
Сообщений: 1,099


Да была дурацкая ошибка, нельзя править в окне форума без проверки :evil: Вместо CirSet в одном месте было CirtSet. Теперь работает, красит окружности в зелёный цвет.
Код:
[Выделить все]
Public Sub CirclesSelect(AcadDoc As AcadDocument)
Dim SelSetColl As AcadSelectionSets
Dim CirSet As AcadSelectionSet
Dim Item As AcadEntity
Dim FilterType(0 To 0) As Integer
Dim FilterData(0 To 0) As Variant

FilterType(0) = 0

FilterData(0) = "Circle"

Set SelSetColl = AcadDoc.SelectionSets
Set CirSet = SelSetColl.Add("763Set28")
CirSet.Select acSelectionSetAll, , , FilterType, FilterData

For Each Item In CirSet

Item.color = acGreen
   
Next Item

CirSet.Delete
Set CirSet = Nothing
Set SelSetColl = Nothing

End Sub

Sub Test()
CirclesSelect ThisDrawing
End Sub
Извиняй, не досмотрел...
{Smirnoff} вне форума  
 
Автор темы   Непрочитано 13.04.2005, 16:58
#7
basboy


 
Регистрация: 11.04.2005
Сообщений: 5
<phrase 1=


ОК.

Спасибо, всё заработало.
basboy вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > VBA, как просканировать окружности на чертеже?

Расчет зданий и сооружений в сейсмоопасных районах
Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск