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

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Не могу разобраться с методом CopyObjects(VBA) помогите

Не могу разобраться с методом CopyObjects(VBA) помогите

Ответ
Поиск в этой теме
Непрочитано 28.04.2012, 21:23 #1
Не могу разобраться с методом CopyObjects(VBA) помогите
Seven
 
Регистрация: 05.04.2011
Сообщений: 14

Мне необходимо программно копировать объекты с одного открытого чертежа в другой. Вот собственно код формы, кнопка Copy нажимается на одном чертеже и выбираем копируемые объекты, переходим на другой и нажимаем кнопку Past и они должны копироваться ... но не копируются Уже мозг себе сломал, ничего не могу понять, помогите пожалуйста. В LISP не разбираюсь ...

Код:
[Выделить все]
Dim Name As String

Private Sub ButtonCopy_Click()

'Переменные программы выбора
Dim objSelSet As AcadSelectionSet
Dim objSelCol As AcadSelectionSets

'Проверяем предыдущие наборы
Set objSelCol = ThisDrawing.SelectionSets
For Each objSelSet In objSelCol
    If objSelSet.Name = "Hrenovina" Then
    objSelSet.Delete
    Exit For
    End If
Next

Set objSelSet = ThisDrawing.SelectionSets.Add("Hrenovina")
'Выбор по запросу
objSelSet.SelectOnScreen

'Запоминаем имя чертежа
Name = ThisDrawing.Name

End Sub

Private Sub ButtonPast_Click()

    'Переменные копирования
    Dim obj() As Object
    Dim objEnt As AcadEntity
    Dim N As Byte
    Dim Skopirovano As Variant
    Dim DOC As AcadDocument
    
    'Определяем размерность массива
    ReDim obj(Documents.Item(Name).SelectionSets.Item("Hrenovina").Count)
    
    'Подготавливаем данные для использования в команде
    N = 0
    For Each objEnt In Documents.Item(Name).SelectionSets.Item("Hrenovina")
        Set obj(N) = objEnt
        N = N + 1
    Next objEnt
    
    Set DOC = Documents.Item(Name)
    
    Skopirovano = DOC.CopyObjects(obj, ThisDrawing.ModelSpace)

End Sub

Вложения
Тип файла: dvb Эксперимент.dvb (48.0 Кб, 49 просмотров)

Просмотров: 6155
 
Непрочитано 28.04.2012, 23:20
#2
hwd

C, C++, C#
 
Регистрация: 07.10.2009
С-Пб.
Сообщений: 2,762
Отправить сообщение для hwd с помощью Skype™


Изучай:
Код:
[Выделить все]
Sub CopyObjectsBetweenDatabases()
    Dim DOC0 As AcadDocument
    Dim circleObj1 As AcadCircle, circleObj2 As AcadCircle
    Dim centerPoint(0 To 2) As Double
    Dim radius1 As Double, radius2 As Double
    Dim objCollection(0 To 1) As Object
    Dim retObjects As Variant
 
    ' Define the Circle object
    centerPoint(0) = 0: centerPoint(1) = 0: centerPoint(2) = 0
    radius1 = 5#: radius2 = 7#
 
    ' Add two circles to the current drawing
    Set circleObj1 = ThisDrawing.ModelSpace.AddCircle _
                     (centerPoint, radius1)
    Set circleObj2 = ThisDrawing.ModelSpace.AddCircle _
                     (centerPoint, radius2)
 
    ' Save pointer to the current drawing
    Set DOC0 = ThisDrawing.Application.ActiveDocument
 
    ' Copy objects
    '
    ' First put the objects to be copied into a form compatible
    ' with CopyObjects
    Set objCollection(0) = circleObj1
    Set objCollection(1) = circleObj2
 
    ' Create a new drawing and point to its model space
    Dim Doc1MSpace As AcadModelSpace
    Dim DOC1 As AcadDocument
 
    Set DOC1 = Documents.Add
    Set Doc1MSpace = DOC1.ModelSpace
 
    ' Copy the objects into the model space of the new drawing. A
    ' collection of the new (copied) objects is returned.
    retObjects = DOC0.CopyObjects(objCollection, Doc1MSpace)
End Sub
И не ленись смотреть мануал - там последним всегда приводится код на VBA.
__________________
Надеюсь, ты не социальный овощ? Это определяется делами! :welcome:
hwd вне форума  
 
Автор темы   Непрочитано 29.04.2012, 01:29
#3
Seven


 
Регистрация: 05.04.2011
Сообщений: 14


Уважаемый hdw что ж вы про меня так плохо думаете, я перед тем как с вопросом лезть все прилежно поизучал ... )
А ошибку ...ФФУххх !!! ... я уже нашел, там где вообще не ждал ее
Код:
[Выделить все]
Dim Name As String

Private Sub ButtonCopy_Click()

'Переменные программы выбора
Dim objSelSet As AcadSelectionSet
Dim objSelCol As AcadSelectionSets

'Проверяем предыдущие наборы
Set objSelCol = ThisDrawing.SelectionSets
For Each objSelSet In objSelCol
    If objSelSet.Name = "Hrenovina" Then
    objSelSet.Delete
    Exit For
    End If
Next

Set objSelSet = ThisDrawing.SelectionSets.Add("Hrenovina")
'Выбор по запросу
objSelSet.SelectOnScreen

'Запоминаем имя чертежа
Name = ThisDrawing.Name

End Sub

Private Sub ButtonPast_Click()

    'Переменные копирования
    Dim obj() As Object
    Dim objEnt As AcadEntity
    Dim N As Byte
    Dim Skopirovano As Variant
    
    'Определяем размерность массива
    ReDim obj(Documents.Item(Name).SelectionSets.Item("Hrenovina").Count - 1)
    'Размер массива надо уменьшать на единицу нумерация ж с нуля
    'Создавалась одна лишняя а потому пустая ячейка массива и АCad был страшно недоволен =)

    'Подготавливаем данные для использования в команде
    N = 0
    For Each objEnt In Documents.Item(Name).SelectionSets.Item("Hrenovina")
        Set obj(N) = objEnt
        N = N + 1
    Next objEnt
    
    'Собственно копируем 
    Skopirovano = Documents.Item(Name).CopyObjects(obj, ThisDrawing.ModelSpace)

End Sub
Seven вне форума  
 
Непрочитано 29.04.2012, 10:53
#4
Дима_

Продуман
 
Регистрация: 22.02.2007
Питер
Сообщений: 2,840


Цитата:
Сообщение от Seven Посмотреть сообщение
что ж вы про меня так плохо думаете, я перед тем как с вопросом лезть все прилежно поизучал ...
По опыту ответов на вопросы такого уровня...
__________________
Когда в руках молоток все вокруг кажется гвоздями.
Дима_ вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Не могу разобраться с методом CopyObjects(VBA) помогите

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Помогите разобраться с показаниями прибора Оникс 2.5 Marya Обследование зданий и сооружений 36 18.10.2019 14:25
Мои динамические блоки [2] Кулик Алексей aka kpblc Динамические блоки 4334 22.04.2019 09:16
Помогите разобраться в расчёте металлических ферм в пространственной схеме в SCAD Stingry SCAD 9 04.01.2012 14:41
Не могу разобраться с *error* Makswell Программирование 22 11.11.2011 00:54
Помогите разобраться c AutoPlant aiver Прочее. Программное обеспечение 2 30.06.2006 07:51