Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 13.11.2015, 15:21   #1
Kefirrr
Пользователь
 
Регистрация: 05.06.2010
Сообщений: 53
По умолчанию создание группы объектов в автокаде из excel

Добрый день. Очень надеюсь на вашу помощь.
Суть в следующем: в автокаде на VBA написан макрос, который создает группу под названием ПРОБА и закидывает туда пару примитивов.
Я хочу чтобы тоже самое делалось и из excel/ Пытаюсь переделать код, но группу автокад так и не создает. Мне кажется, что я как-то не так обращаюсь к объекту ГРУППЫ

Код:
Sub group()
'-------------------------------------------------
Set acadApp = GetObject(, "AutoCAD.Application")
  Set objDoc = acadApp.ActiveDocument
  AppActivate acadApp.Caption
    Application.DisplayAlerts = False 'отключаем не нужные сообщения
      
    'проверяем открыт автокад или нет

    On Error Resume Next
    Set acadApp = GetObject(, "AutoCAD.Application")
    On Error GoTo 0
    
    
    'Проверяем активный документ
    On Error Resume Next
    Set acadDoc = acadApp.ActiveDocument
    On Error GoTo 0
    
    'Если активных нет- создаем новый слой
    If acadDoc Is Nothing Then
        Set acadDoc = acadApp.Documents.Add
        acadApp.Visible = True
    End If
   
'Dim AML As AcadMLeader
Dim xx As Long
Dim ss As String
'-------------------------------------------------


Dim index
index = "ПРОБА"
    
    Dim oGroup As Variant ' так же пробовала и Object
    'Set oGroup = GetObject(AcadGroup, "AutoCAD.Application") ' Мне кажется, что здесь главная ошибка
' пробовала по-всякому: GetObject(, "AutoCAD.Application")
    Dim vPick As Variant
    Dim oEnt As Variant
    Dim oEnts() As Variant
    Dim i As Integer
    
    Dim newObjs As Object
    Dim basePnt As Variant
    Dim MyExit As Boolean
    On Error Resume Next
    Dim n, a
    n = 0
    a = 0
    Set oGroup = acadDoc.ModelSpace.group.Add(index)
        

        On Local Error Resume Next
    Do Until Err.Number <> 0
        ReDim Preserve oEnts(0 To i)
        ThisDrawing.Utility.GetEntity oEnt, vPick, vbCr _
             & "Select object to place in new group: "
        Set oEnts(i) = oEnt
        i = i + 1
        a = oEnt.Length
        n = n + a
        oEnt.Highlight True
        oEnt.Highlight False
        Loop
        n = n - a
    oGroup.AppendItems oEnts
    
    oEnts(i).Highlight (False)
    LB_dlina = n
    oGroup.SelectOnScreen
End Sub

Последний раз редактировалось Kefirrr; 13.11.2015 в 15:24.
Kefirrr вне форума Ответить с цитированием
Старый 13.11.2015, 17:57   #2
doober
Старожил
 
Аватар для doober
 
Регистрация: 02.05.2009
Сообщений: 3,907
По умолчанию

Цитата:
Сообщение от Kefirrr Посмотреть сообщение
в автокаде на VBA написан макрос, который создает группу под названием ПРОБА
Не верю,нет такого метода
Set oGroup = acadDoc.ModelSpace.group.Add(index)
Есть такой
Set oGroup = acadDoc.Groups.Add(Index)
ThisDrawing замените на acadDoc
Анализ,обработка данных Недорого
doober вне форума Ответить с цитированием
Старый 13.11.2015, 18:34   #3
Kefirrr
Пользователь
 
Регистрация: 05.06.2010
Сообщений: 53
По умолчанию

doober, в который раз ВЫ меня наставляете на путь истинный!
СПАСИБО. а я как всегда лошарик
Kefirrr вне форума Ответить с цитированием
Старый 15.11.2015, 00:19   #4
Kefirrr
Пользователь
 
Регистрация: 05.06.2010
Сообщений: 53
По умолчанию

Можно еще вопрос?
у есть код, который добавляет выделенные объекты в определенную группу:
Код:
Sub group() '
'-------------------------------------------------
Set ACADApp = GetObject(, "AutoCAD.Application")
  Set objDoc = ACADApp.ActiveDocument
  AppActivate ACADApp.Caption
    Application.DisplayAlerts = False '
     
    On Error Resume Next
    Set ACADApp = GetObject(, "AutoCAD.Application")
    On Error GoTo 0
 
    On Error Resume Next
    Set acadDoc = ACADApp.ActiveDocument
    On Error GoTo 0
    
       If acadDoc Is Nothing Then
        Set acadDoc = ACADApp.Documents.Add
        ACADApp.Visible = True
    End If
   
'Dim AML As AcadMLeader
Dim xx As Long
Dim ss As String
'-------------------------------------------------
Dim index
index = ActiveCell.value

    Dim oGroup As Variant
    Dim vPick As Variant
    Dim oEnt As Object
    Dim oEnts() As Object
    Dim i As Integer
    
    Dim newObjs As Object
    Dim basePnt As Variant
    Dim MyExit As Boolean
    On Error Resume Next
    Dim n, a
    n = 0
    a = 0
     Dim ObjForGroup() As Object
    Set oGroup = acadDoc.groups.Add(index)
         Dim acSelSet As Object
  Dim intCnt As Integer
  Dim objArray(0) As Object
  Dim AnyObj As Object
  Dim AnyPnt As Variant
  Set acSelSet = acadDoc.SelectionSets.Add("test")
  acSelSet.SelectOnScreen
  'For Each Item In acSelSet
  
          On Local Error Resume Next
    ObjCntr = acSelSet.count
ReDim Preserve ObjForGroup(0 To (ObjCntr - 1)) ' As Object '<-- changed to the # of entities created
    For count = acSelSet.count - 1 To acSelSet.count - ObjCntr Step -1 '<- changed to the last # of entities
        Set ObjForGroup(cntr) = acSelSet.item(count)
        cntr = cntr + 1
    Next
    oGroup.AppendItems ObjForGroup
        acadDoc.SelectionSets.item("test").Delete

End Sub
А как можно узнать каким группам принадлежит определенный объект?
Если средствами автокада пользоваться-то это "найти имя", а хотелось бы именно средствами VBA
нашла описание групп http://entercad.ru/acadauto.en/, но все равно пока не получается
Kefirrr вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Создание нескольких (группы) 3D объектов в wpf p0keT WPF, UWP, WinRT, XAML 4 05.03.2015 17:37
перемещение блоков в автокаде используя excel vba Kefirrr Microsoft Office Excel 11 04.10.2014 19:55
Создание и уничтожение объектов. Время жизни объектов C++/C# Anett// Помощь студентам 0 24.10.2011 23:26
Создание группы классов WIN32APIist Общие вопросы C/C++ 5 10.01.2011 09:43
Выделение группы объектов на C# EagleNN C# (си шарп) 2 08.10.2010 23:35