IPB

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

 Правила форума Всем прочитать перед созданием темы!
3 страниц V  < 1 2 3  
Ответить в данную темуНачать новую тему
VBA for ACAD
oleg2007
сообщение 5.09.2009 - 00:21
Сообщение #41


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

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



Подскажите какой командой выбрать все объекты например линии из всех выбранных объектов?
Перейти в начало страницы
Вставить ник
+Цитировать сообщение
Agens
сообщение 15.10.2009 - 16:01
Сообщение #42


Из местных
Иконка группы

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



Dim objCount As Integer
Dim I As Integer

objCount = ThisDrawing.ModelSpace.Count
For I = 3 To ThisDrawing.Blocks.Count - 1
MsgBox ThisDrawing.Blocks.Item(I).Name
Next

Думаю, сам потом разберешься...

Сообщение отредактировал Agens - 15.10.2009 - 16:02
Перейти в начало страницы
Вставить ник
+Цитировать сообщение
kpblc
сообщение 15.10.2009 - 20:58
Сообщение #43


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

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



Вопрос: объекты, входящие в блоки - учитывать или нет? Если не учитывать входящие в блоки, то кто мешает создать соответствующий SelectionSet с фильтром по имени объекта?
Перейти в начало страницы
Вставить ник
+Цитировать сообщение
Agens
сообщение 16.10.2009 - 10:21
Сообщение #44


Из местных
Иконка группы

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



Вот я знаю как найти например однострочный текст (как Крыс описал), как изменить свойства текта каждого отдельно и по порядку, а как ВЫБРАТЬ весь текст, Крыс, не подскажешь (чтобы можно было изменять свойства всего и сразу)?
Перейти в начало страницы
Вставить ник
+Цитировать сообщение
kpblc
сообщение 16.10.2009 - 12:13
Сообщение #45


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

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



Если текст, входящий в блоки, исключается из обработки, то опять же - SelectionSet (ох, сколько ж я с VBA не работал... Попробую наваять, но за корректность работы не отвечаю):
Код
Option Explicit

Type LayerEnt
  name As String
  IsLocked As Boolean
  IsFrozen As Boolean
End Type

Private Function LayerStatusSave() As LayerEnt()
Dim res() As LayerEnt, ArSize As Integer
Dim LayerItem As AcadLayer
  For Each LayerItem In ThisDrawing.Layers
    If Not (LayerItem.name Like "*|*") Then
      On Error GoTo lErrorReDim
      ReDim Preserve res(UBound(res))
      ArSize = UBound(res)
      res(ArSize).name = LayerItem.name
      res(ArSize).IsLocked = LayerItem.Lock
      res(ArSize).IsFrozen = LayerItem.Freeze
      On Error Resume Next
      LayerItem.Lock = False
      LayerItem.Freeze = False
    End If
  Next
  LayerStatusSave = res
  Exit Function
lErrorReDim:
  ReDim res(0)
  Resume Next
End Function

Private Function LayerStatusRestore(ByRef LayerStatusList() As LayerEnt)
Dim Item As Integer
  With ThisDrawing.Layers
    For Item = LBound(LayerStatusList) To UBound(LayerStatusList)
      On Error Resume Next
      .Item(LayerStatusList(Item).name).Lock = LayerStatusList(Item).IsLocked
      .Item(LayerStatusList(Item).name).Freeze = LayerStatusList(Item).IsFrozen
    Next
  End With
  ReDim LayerStatusList(0)
  On Error GoTo 0
End Function

Public Sub test()
Dim lst() As LayerEnt, SelSetName As String, SelSet As AcadSelectionSet
Dim dxtInt() As Integer, dxfType() As Variant
  SelSetName = "lavteam_selectionset"
  On Error Resume Next
  With ThisDrawing.SelectionSets
    .Item(SelSetName).Clear
    .Item(SelSetName).Delete
    Set SelSet = .Add(SelSetName)
    ReDim dxfint(0): ReDim dxfType(0)
    dxfint(0) = 0: dxfType(0) = "TEXT"
    SelSet.Select acSelectionSetAll, dxfint, dxfType
  End With
    
  lst = LayerStatusSave()
  Dim objpointer As AcadEntity
  For Each objpointer In SelSet
    ' Делаем чего-то
    objpointer.color = acRed
  Next
  LayerStatusRestore lst
  ThisDrawing.Regen acAllViewports
End Sub

P.S. Если надо обрабатывать внутри блоков, то ситуация изменится: надо будет делать, скорее всего, рекурсию для доступа ко всем объектам внутри вставленных блоков. На лиспе я такое сделаю достаточно быстро и просто, на VBA - надо проверять.

Сообщение отредактировал kpblc - 16.10.2009 - 22:38
Перейти в начало страницы
Вставить ник
+Цитировать сообщение
Agens
сообщение 20.10.2009 - 10:05
Сообщение #46


Из местных
Иконка группы

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



А можно "на пальцах"...
Для развития мысли нужно следующее:
1. вот есть два слова.
2. надо их выбрать
3. поменять их накрон
как это сделать поочередно, я знаю, а как сделать выбрать весь тект и поменять наклон в выбранном тексте?
Не надо целого макроса... нужна логика smile.gif
SelSet.Select acSelectionSetAll, dxfint, dxfType это и есть добавление в набор, где SelSet - сам нам нужный набор?
Перейти в начало страницы
Вставить ник
+Цитировать сообщение
kpblc
сообщение 20.10.2009 - 17:07
Сообщение #47


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

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



Так а логика-то проста: создается SelectionSet с фильтром; размораживаются слои; через For Each проход по каждому элементу SelectionSet'a с модификацией и возврат слоев с исходное состояние...
Перейти в начало страницы
Вставить ник
+Цитировать сообщение
Agens
сообщение 21.10.2009 - 16:49
Сообщение #48


Из местных
Иконка группы

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



спасибо... получилось вот в таком варианте:
Цитата
Dim SelSetName As String, SelSet As AcadSelectionSet
Dim dxtInt() As Integer, dxfType() As Variant
SelSetName = "lavteam_selectionset"
On Error Resume Next
With ThisDrawing.SelectionSets
.Item(SelSetName).Clear
.Item(SelSetName).Delete
Set SelSet = .Add(SelSetName)
ReDim dxfint(0): ReDim dxfType(0)
dxfint(0) = 0: dxfType(0) = "TEXT"
SelSet.Select acSelectionSetAll, dxfint, dxfType
End With

Dim objpointer As AcadEntity
For Each objpointer In SelSet
' Делаем чего-то
objpointer.color = acRed
Next
ThisDrawing.Regen acAllViewports


т.е. без работы с разморозкой и заморозкой слоев...
Перейти в начало страницы
Вставить ник
+Цитировать сообщение
kpblc
сообщение 21.10.2009 - 17:37
Сообщение #49


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

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



Для ради интересу: сделай объект текста, заблокируй слой, на котором он находится, и потом выполни свой макрос.
Перейти в начало страницы
Вставить ник
+Цитировать сообщение
Agens
сообщение 22.10.2009 - 08:08
Сообщение #50


Из местных
Иконка группы

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



Скорее всего выдаст ошику...
Твой макрос и линии делает красными smile.gif
---
Почему этот примет тоже текст делает красным...?

----------------------------------------------------------
Dim ssetObj As AcadSelectionSet

With ThisDrawing.SelectionSets
.Item(SelSetName).Clear
.Item(SelSetName).Delete
End With

Set ssetObj = ThisDrawing.SelectionSets.Add("SSET")

Dim mode As Integer

mode = acSelectionSetAll 'acSelectionSetCrossing
gpCode = 0
dataValue = "Circle"

ssetObj.Select mode, groupCode, dataCode

For Each objpointer In ssetObj
objpointer.color = acRed
Next

ThisDrawing.Regen acAllViewports

Сообщение отредактировал Agens - 22.10.2009 - 08:21
Перейти в начало страницы
Вставить ник
+Цитировать сообщение
kpblc
сообщение 22.10.2009 - 08:20
Сообщение #51


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

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



Так я на VBA и не пишу smile.gif Вообще smile.gif Лисп нарисовать - это другое дело, там все проще. Сделать лиспик?
Перейти в начало страницы
Вставить ник
+Цитировать сообщение
Agens
сообщение 22.10.2009 - 08:22
Сообщение #52


Из местных
Иконка группы

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



object.Select Mode[, Point1][, Point2][, FilterType][, FilterData]
Какой долежн быть код, чтобы выбрал все круги в моделе?
Перейти в начало страницы
Вставить ник
+Цитировать сообщение
kpblc
сообщение 22.10.2009 - 08:29
Сообщение #53


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

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



Нечто типа:
Код
dxfType(0)=0: dxfData(0)="CIRCLE"
object.Select Mode dxfType, dxfData

Сейчас кад не запустить, так что код надо будет "добивать": объявить object как SelectionSet и установить Mode в один из режимов.
Перейти в начало страницы
Вставить ник
+Цитировать сообщение
Agens
сообщение 18.12.2009 - 12:54
Сообщение #54


Из местных
Иконка группы

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



Я научился создавать стиль таблицы и менять свойства стиля. Умею рисовать таблицу, менять ее свойства и заполнять. Но как нарисовать таблицу и сделать ее определеного стиля не понял. ПОМОГИТЕ!!!
Перейти в начало страницы
Вставить ник
+Цитировать сообщение
kpblc
сообщение 21.12.2009 - 00:26
Сообщение #55


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

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



Да в общем-то все как обычно: создаешь объект ACAD_TABLE, потом назначаешь ему стиль. В чем трудность?
Перейти в начало страницы
Вставить ник
+Цитировать сообщение

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

 



RSS Текстовая версия Сейчас: 27.06.2019 - 12:18