IPB

Здравствуйте, гость ( Вход | Регистрация )

 Правила форума Всем прочитать перед созданием темы!
3 страниц V   1 2 3 >  
Ответить в данную темуНачать новую тему
VBA for ACAD
Agens
сообщение 4.05.2009 - 10:16
Сообщение #1


Завсегдатай
Иконка группы

Группа: Пользователи
Пользователь №: 89781
Сообщений: 104
Регистрация: 28.04.2008
Загружено: байт
Скачано: байт
Коэффициент: ---
Спасибо сказали: 10 раз(а)



Может есть тут специалисты по VBА, хочу для ACADа на VBA реализовать след. вещь - поиск элементов (линий, блоков и т.д.) аналог команды - "_qselect". Для начала надо найти в чертеже все блоки с именем "*Ux", где х - лубое число от 0 до 1000 и выбрать их... можте кто поможет, подскажет...
или может кто пример скинет, чтобы просто выбирал все линии, а я потом разберусь как нить... Спасибо... Жду...
Перейти в начало страницы
Вставить ник
+Цитировать сообщение
blackpoint
сообщение 4.05.2009 - 22:35
Сообщение #2


Новичок
Иконка группы

Группа: Пользователи
Пользователь №: 85877
Сообщений: 2
Регистрация: 8.02.2008
Загружено: байт
Скачано: байт
Коэффициент: ---
Спасибо сказали: 2 раз(а)



Public Sub purgeLines()
Dim obj As Object
For Each obj In ModelSpace
If TypeName(obj) = "IAcadLine" Then
Dim line As AcadLine
Set line = obj
line.Delete
End If
Next
End Sub
Перейти в начало страницы
Вставить ник
+Цитировать сообщение
blackpoint
сообщение 4.05.2009 - 23:04
Сообщение #3


Новичок
Иконка группы

Группа: Пользователи
Пользователь №: 85877
Сообщений: 2
Регистрация: 8.02.2008
Загружено: байт
Скачано: байт
Коэффициент: ---
Спасибо сказали: 2 раз(а)



Для ссылок на блоки (сами определения остаются):
Код
Public Sub purge()
    Dim obj As Object
    For Each obj In ModelSpace
        If TypeName(obj) = "IAcadBlockReference" Then
            Dim blckref As AcadBlockReference
            Set blckref = obj
            If blckref.Name = "test" Then
                blckref.Delete
            End If
        End If
    Next
End Sub
Перейти в начало страницы
Вставить ник
+Цитировать сообщение
kpblc
сообщение 4.05.2009 - 23:34
Сообщение #4


Свой человек
Иконка группы

Группа: Пользователи
Пользователь №: 9904
Сообщений: 652
Регистрация: 31.01.2005
Из: С.-Петербург
Загружено: байт
Скачано: байт
Коэффициент: ---
Спасибо сказали: 36 раз(а)



А что делать, если блоки лежат в пространствах листов? smile.gif
По-моему, более верным будет код наподобие
Код
Option Explicit

Public Sub EraseBlocks(Optional sBlockName As String)
Dim blkRef As AcadBlock
  If IsMissing(sBlockName) Then sBlockName = "*"
  On Error Resume Next
  For Each blkRef In ThisDrawing.Blocks
    blkRef.Erase
  Next blkRef
Dim oLayout As AcadLayout, blkLay As AcadBlock, oEnt As AcadEntity
  For Each oLayout In ThisDrawing.Layouts
    Set blkLay = oLayout.Block
    For Each oEnt In blkLay
      If oEnt.ObjectName = "AcDbBlockReference" And UCase(oEnt.Name) Like UCase(sBlockName) Then
        oEnt.Delete
      End If
    Next oEnt
  Next oLayout
End Sub

Вечно путаю методы .Erase и .Delete, так что проверяйте.
Перейти в начало страницы
Вставить ник
+Цитировать сообщение
Agens
сообщение 5.05.2009 - 09:09
Сообщение #5


Завсегдатай
Иконка группы

Группа: Пользователи
Пользователь №: 89781
Сообщений: 104
Регистрация: 28.04.2008
Загружено: байт
Скачано: байт
Коэффициент: ---
Спасибо сказали: 10 раз(а)



я как то сделал быстрее...
Цитата
Dim blockObj As AcadBlock
MsgBox "я нашел - " & ThisDrawing.Blocks.count - 3 & " блока(ов)"
For k = 3 To ThisDrawing.Blocks.count - 1
Next k

но я нашел блоки не на листе, а существующие блоки, среди имен "count" есть и мои блоки,
имя я могу найти как "ThisDrawing.Blocks.Item(k).Name", где к от 3 до ThisDrawing.Blocks.count - 1,
но дальше тупик, как применить Explode, к AcadBlock нельзя, только к AcadBlockReference.
Как мне перейти от AcadBlock к AcadBlockReference? или у меня путь не тот...
т.к. как найти какие блоки вставлены в чертеж и к ним применить Explode?
---
пример посмотрю, спасибо...

Сообщение отредактировал Agens - 5.05.2009 - 09:10
Перейти в начало страницы
Вставить ник
+Цитировать сообщение
kpblc
сообщение 5.05.2009 - 09:21
Сообщение #6


Свой человек
Иконка группы

Группа: Пользователи
Пользователь №: 9904
Сообщений: 652
Регистрация: 31.01.2005
Из: С.-Петербург
Загружено: байт
Скачано: байт
Коэффициент: ---
Спасибо сказали: 36 раз(а)



Ты вот что определи - у тебя имена блоков твоих есть? Если да, то как вариант (я код не проверял):
Код
Type typLayer
  oPointer As Object
  IsLock As Boolean
  IsFrozen As Boolean
End Type

Public Sub ExplodeBlocksExcule(Optional sBlockNameExclude As String)
  If IsMissing(sBlockNameExclude) Then
    sBlockNameExclude = "*"
  Else
    sBlockNameExclude = UCase(sBlockNameExclude)
  End If
Dim oLayer As AcadLayer, arLayers() As typLayer, iCounter As Integer
  ReDim arLayers(ThisDrawing.Layers.Count - 1)
  iCounter = 0
On Error Resume Next
  For Each oLayer In ThisDrawing.Layers
    arLayers(iCounter).oPointer = oLayer
    arLayers(iCounter).IsFrozen = oLayer.Freeze
    arLayers(iCounter).IsLock = oLayer.Lock
    oLayer.Freeze = False
    oLayer.Lock = False
  Next oLayer
On Error GoTo 0
Dim oBlockDef As AcadBlock, oEnt As AcadEntity
  For Each oBlockDef In ThisDrawing.Blocks
    For Each oEnt In oBlockDef
      If oEnt.ObjectName = "AcDbBlockReference" And UCase(oEnt.Name) Like sBlockNameExclude Then
        oEnt.Explode
        oEnt.Erase
      End If
    Next oEnt
  Next oBlockDef
On Error Resume Next
  For iCounter = 0 To UBound(arLayers)
    arLayers(iCounter).oPointer.Lock = arLayers(iCounter).IsLock
    arLayers(iCounter).oPointer.Freeze = arLayers(iCounter).IsFrozen
  Next iCounter
End Sub
Перейти в начало страницы
Вставить ник
+Цитировать сообщение
Agens
сообщение 5.05.2009 - 09:35
Сообщение #7


Завсегдатай
Иконка группы

Группа: Пользователи
Пользователь №: 89781
Сообщений: 104
Регистрация: 28.04.2008
Загружено: байт
Скачано: байт
Коэффициент: ---
Спасибо сказали: 10 раз(а)



уфф... я не такой спец по VBA, в этом коде ничего не понимаю... я думал - все просто...
есть ACADBlocks в чертеже (допусти три блока с именем 1, 2 и 3)
блоки 1 и 2 уже вставлены в чертеж, а блок 3 просто существует...
мне надо найти из блок с именем 2 и разчленить его... буду сам думать...
Перейти в начало страницы
Вставить ник
+Цитировать сообщение
kpblc
сообщение 5.05.2009 - 09:43
Сообщение #8


Свой человек
Иконка группы

Группа: Пользователи
Пользователь №: 9904
Сообщений: 652
Регистрация: 31.01.2005
Из: С.-Петербург
Загружено: байт
Скачано: байт
Коэффициент: ---
Спасибо сказали: 36 раз(а)



Я тоже предпочитаю VisualLISP smile.gif А так-то по логике все просто: сначала разблокируются и включаются все слои; потом проходим по коллекции блоков. Внутри каждого описания блока проходим по элементам этого блока (пользуясь тем, что, например, пространство модели - тоже описание блока). Если, уже находясь внутри описания какого-то блока, натыкаемся на AcDbBlockReference (то есть вхождение блока), и имя этого блока похоже на sBlockNameExclude, то мы этот элемент расчленяем и удаляем. А потом восстановление состояния слоев в исходное состояние.
P.S. Вызывать код можно как
Код
Sub Test()
  ExplodeBlocksExcule 'разбить вообще все блоки
End Sub

Sub Test1()
  ExplodeBlocksExcule "2" 'Разбить все блоки с именем "2"
End Sub

Sub Test2()
  ExplodeBlocksExcule "*2*" ' Разбить все блоки с именами, в которых содержится цифра 2
End Sub


Сообщение отредактировал kpblc - 5.05.2009 - 09:45
Перейти в начало страницы
Вставить ник
+Цитировать сообщение
Agens
сообщение 5.05.2009 - 12:42
Сообщение #9


Завсегдатай
Иконка группы

Группа: Пользователи
Пользователь №: 89781
Сообщений: 104
Регистрация: 28.04.2008
Загружено: байт
Скачано: байт
Коэффициент: ---
Спасибо сказали: 10 раз(а)



короче сделал я все проще
Цитата
Private Sub CommandButton1_Click()
Dim blockObj As AcadBlock
If Left(ThisDrawing.Blocks.Item(k).Name, 2) = "имя" Then
stopflag = Val(Right(ThisDrawing.Blocks.Item(k).Name, Len(ThisDrawing.Blocks.Item(k).Name) - 2))
End If
Dim objSelSet As AcadSelectionSet
Dim objSelCol As AcadSelectionSets
Dim intType(0) As Integer
Dim varData(0) As Variant
Set objSelCol = ThisDrawing.SelectionSets
For Each objSelSet In objSelCol
If objSelSet.Name = "blocks" Then
objSelSet.Delete
Exit For
End If
Next
Set objSelSet = ThisDrawing.SelectionSets.Add("blocks")
mode = acSelectionSetAll
intType(0) = 0 'Фильтры выбора
varData(0) = "INSERT" '"INSERT" для выбора блока
'objSelSet.SelectOnScreen intType, varData
objSelSet.Select mode, 0, 0, intType, varData
Set SelectOnlyOnScreen = objSelSet
Set acSelSet = SelectOnlyOnScreen
For I = 0 To acSelSet.count - 1
Next I
MsgBox "Найдено и разбито " & CStr(acSelSet.count) & " блока(ов)..."

End Sub

но тут со своими тонкостями...
Перейти в начало страницы
Вставить ник
+Цитировать сообщение
kpblc
сообщение 5.05.2009 - 12:49
Сообщение #10


Свой человек
Иконка группы

Группа: Пользователи
Пользователь №: 9904
Сообщений: 652
Регистрация: 31.01.2005
Из: С.-Петербург
Загружено: байт
Скачано: байт
Коэффициент: ---
Спасибо сказали: 36 раз(а)



Ага, с тонкостями... Не обрабатываются "вложенные" блоки. В фильтре выбора нет дополнительной фильтрации по имени блока. В коде нет прямого указания на разбитие блока.
Перейти в начало страницы
Вставить ник
+Цитировать сообщение
Agens
сообщение 5.05.2009 - 14:01
Сообщение #11


Завсегдатай
Иконка группы

Группа: Пользователи
Пользователь №: 89781
Сообщений: 104
Регистрация: 28.04.2008
Загружено: байт
Скачано: байт
Коэффициент: ---
Спасибо сказали: 10 раз(а)



я не показывал эту часть...
Цитата
...
Set objSelSet = ThisDrawing.SelectionSets.Add("blocks")
mode = acSelectionSetAll
intType(0) = 0
varData(0) = "INSERT"
objSelSet.Select mode, 0, 0, intType, varData
Set SelectOnlyOnScreen = objSelSet
Set acSelSet = SelectOnlyOnScreen
For i = 0 To acSelSet.count - 1
del_flag = 0
For j = stopflag - acSelSet.count - 1 To stopflag
numb = Right(Str(j), Len(Str(j)) - 1)
block_name = "*U" + numb
If objSelSet.Item(i).Name = block_name Then
objSelSet.Item(i).Explode
del_flag = 1
End If
Next j
If del_flag = 1 Then objSelSet.Item(i).Delete
Next i

Вчера только начал разбираться с МИФом для Акада... Книги нет толковой, да и времени...

Сообщение отредактировал Agens - 5.05.2009 - 14:19
Перейти в начало страницы
Вставить ник
+Цитировать сообщение
kpblc
сообщение 5.05.2009 - 14:03
Сообщение #12


Свой человек
Иконка группы

Группа: Пользователи
Пользователь №: 9904
Сообщений: 652
Регистрация: 31.01.2005
Из: С.-Петербург
Загружено: байт
Скачано: байт
Коэффициент: ---
Спасибо сказали: 36 раз(а)



.Delete просто удалит блок. А где разбитие?
Я зануда та еще smile.gif
Перейти в начало страницы
Вставить ник
+Цитировать сообщение
Agens
сообщение 5.05.2009 - 14:23
Сообщение #13


Завсегдатай
Иконка группы

Группа: Пользователи
Пользователь №: 89781
Сообщений: 104
Регистрация: 28.04.2008
Загружено: байт
Скачано: байт
Коэффициент: ---
Спасибо сказали: 10 раз(а)



Цитата(kpblc @ 5.05.2009 - 14:03) *
.Delete просто удалит блок. А где разбитие?
Я зануда та еще smile.gif

поправил...
книгу бы лучше бы дал какую на русском smile.gif хорошую smile.gif
Перейти в начало страницы
Вставить ник
+Цитировать сообщение
kpblc
сообщение 5.05.2009 - 14:25
Сообщение #14


Свой человек
Иконка группы

Группа: Пользователи
Пользователь №: 9904
Сообщений: 652
Регистрация: 31.01.2005
Из: С.-Петербург
Загружено: байт
Скачано: байт
Коэффициент: ---
Спасибо сказали: 36 раз(а)



А нету у меня такой книги. Встроенной справки зачастую достаточно. Правда, на английском smile.gif
А для сложных вопросов и существуют форумы wink.gif
Перейти в начало страницы
Вставить ник
+Цитировать сообщение
Agens
сообщение 5.05.2009 - 14:31
Сообщение #15


Завсегдатай
Иконка группы

Группа: Пользователи
Пользователь №: 89781
Сообщений: 104
Регистрация: 28.04.2008
Загружено: байт
Скачано: байт
Коэффициент: ---
Спасибо сказали: 10 раз(а)



kpblc, вот у меня objSelSet.Item(i).Name - это имя блока, objSelSet.Item(stopflag - 1).Layer - имя слоя этого блока...
как мне тут сделать фильтр, что если слой с именем objSelSet.Item(stopflag - 1).Layer заблокирован, то то-то
objSelSet.Item(stopflag - 1).Layer.Lock = False не получается sad.gif
т.е. хочу написать
if objSelSet.Item(stopflag - 1).Layer(слой) = заблокирован, то objSelSet.Item(i).Delete не надо!!!
Помоги, а!!!
Перейти в начало страницы
Вставить ник
+Цитировать сообщение
kpblc
сообщение 5.05.2009 - 14:34
Сообщение #16


Свой человек
Иконка группы

Группа: Пользователи
Пользователь №: 9904
Сообщений: 652
Регистрация: 31.01.2005
Из: С.-Петербург
Загружено: байт
Скачано: байт
Коэффициент: ---
Спасибо сказали: 36 раз(а)



Сейчас лиспом машина занята по самое не хочу, поэтому пишу насухую
Код
If Not (ThisDrawing.Layers.Item(objSelSet.Item(i).Layer).Lock) Then
objSelSet.Item(i).Explode
objSelSet.Item(i).Erase
End If
по идее для коллекции слоев допускается и нормально срабатывает Item(ИмяСлоя).
---
Исправил 1 опечатку и положение 1 скобки

Сообщение отредактировал kpblc - 5.05.2009 - 14:35
Перейти в начало страницы
Вставить ник
+Цитировать сообщение
Agens
сообщение 5.05.2009 - 14:41
Сообщение #17


Завсегдатай
Иконка группы

Группа: Пользователи
Пользователь №: 89781
Сообщений: 104
Регистрация: 28.04.2008
Загружено: байт
Скачано: байт
Коэффициент: ---
Спасибо сказали: 10 раз(а)



Спасибо... работает... эх... я тоже так хочу "шарить" в VBA...
добавил строчку с Freeze у себя

Сообщение отредактировал Agens - 5.05.2009 - 14:43
Перейти в начало страницы
Вставить ник
+Цитировать сообщение
kpblc
сообщение 5.05.2009 - 14:43
Сообщение #18


Свой человек
Иконка группы

Группа: Пользователи
Пользователь №: 9904
Сообщений: 652
Регистрация: 31.01.2005
Из: С.-Петербург
Загружено: байт
Скачано: байт
Коэффициент: ---
Спасибо сказали: 36 раз(а)



Пока не забыл: для полноты картины я бы задумался еще и о замороженных слоях.
<offtop>Я немного соображаю в лиспе и на основе этого пишу VBA-шный код... Грубо говоря, "портирую" код smile.gif
Но за добрые слова спасибо smile.gif Приятно, черт возьми wink.gif</offtop>

Сообщение отредактировал kpblc - 5.05.2009 - 14:45
Перейти в начало страницы
Вставить ник
+Цитировать сообщение
Agens
сообщение 5.05.2009 - 15:06
Сообщение #19


Завсегдатай
Иконка группы

Группа: Пользователи
Пользователь №: 89781
Сообщений: 104
Регистрация: 28.04.2008
Загружено: байт
Скачано: байт
Коэффициент: ---
Спасибо сказали: 10 раз(а)



слушай, а ты не знаеешь, как сделать так, чтобы пока команда ThisDrawing.SendCommand, посланная в командрую строку не выбрала рамку (я не выбрал рамку smile.gif ), остальной макрос не выполнялся?
Перейти в начало страницы
Вставить ник
+Цитировать сообщение
kpblc
сообщение 5.05.2009 - 15:14
Сообщение #20


Свой человек
Иконка группы

Группа: Пользователи
Пользователь №: 9904
Сообщений: 652
Регистрация: 31.01.2005
Из: С.-Петербург
Загружено: байт
Скачано: байт
Коэффициент: ---
Спасибо сказали: 36 раз(а)



Стоп. А что ты посылаешь в ком.строку? Если набор формировать, то смотри SelectSets.Add (да и так у тебя уже есть аналог; ключи только надо поменять).
Перейти в начало страницы
Вставить ник
+Цитировать сообщение

3 страниц V   1 2 3 >
Ответить в данную темуНачать новую тему
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 



RSS Текстовая версия Сейчас: 29.03.2024 - 16:28