Тема: Как связать диалоговое окно с блоком?
Помогите!!!Как сделать чтобы при 2-ом нажатие на блок в акаде появилось окно в котором можно ввести данные, которые после закрытия отобразились на экране?
Информационный портал для профессионалов в области САПР
Вы не вошли. Пожалуйста, войдите или зарегистрируйтесь.
Форумы CADUser → Программирование → VBA → Как связать диалоговое окно с блоком?
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Помогите!!!Как сделать чтобы при 2-ом нажатие на блок в акаде появилось окно в котором можно ввести данные, которые после закрытия отобразились на экране?
Надо добавить к блоку видимый атрибут.
Так это ясно что блок с атрибутом! Так я и спрашиваю как. Помогите небольшой программкой!
> bob
А зачем программка? Создать новый атрибут не катит?
Выделил блок - правый пинок - Edit block in place и понеслась.
---
ИМХО
Присылай на мыло какие конкретно данные нужно привязать к блокам.
Dblclick_у по блоку (можно конкретному ), будет вылетать диалог с привязанными данными (хоть к внешней БД , хоть внутри файла-чертежа).
С уважением Вован.
Как сделать:
1. Если в чертеже есть блок из заданного списка
(например Формат_А4,Формат_А3....) то
при нажатие на кнопку с макросом
открывалось мое диологовое окно, в котором соответственно происходят
различные записи, а когда происходт выбор в графе
"Формат ComboBox" из списка (например Формат_А4,Формат_А3....)
происходила бы замена при выходе из диологового окна старого блока на новый.
2. Как вывести список значений в "ComboBox",
например нужно для графы "Разработал ComboBox" такой список ИВанов,Петров,Сидоров
3. Как привязать к окну (ComboBox, TextBox) атрибут с определенным именем(ТАГОМ)?
В данном примере (тексте программы) имена атрибутов получены исходя из их расположения
в блоке(порядке создания), т.е если вдруг порядок их расположения изменился,
то требуемый атрибут не будет соответствовать нужному окну.
В моем случае нужно(атрибут-окно):
НАИМЕНОВАНИЕ - "НАИМЕНОВАНИЕ TextBox"
ОБОЗНАЧЕНИЕ - "ОБОЗНАЧЕНИЕ TextBox"
ОБОЗНАЧЕНИЕ - "ОБОЗНАЧЕНИЕ TextBox"
ВИД ЧЕРТЕЖА - "ВИД_ЧЕРТЕЖА ComboBox"
ПЕРВИЧНАЯ ПРИМ. - "ПЕРВИЧНАЯ_ПРИМ. TextBox"
РАЗРАБОТАЛ - "РАЗРАБОТАЛ ComboBox"
ПРОВЕРИЛ - "ПРОВЕРИЛ ComboBox"
Т.КОНТРОЛЬ - "Т_КОНТРОЛЬ ComboBox"
Н.КОНТРОЛЬ - "Н_КОНТРОЛЬ ComboBox"
УТВЕРДИЛ - "УТВЕРДИЛ ComboBox"
СВОБОДНАЯ ГРАФА - "СВОБОДНАЯ_ГРАФА ComboBox"
ФАМИЛИЯ СВ.ГР. - "ФАМИЛИЯ_СВ_ГР ComboBox"
ЛИТЕРА - "ЛИТЕРА TextBox"
ЛИСТ - "ЛИСТ TextBox"
ЛИСТОВ - "ЛИСТОВ TextBox"
МАССА - "МАССА TextBox"
МАСШТАБ - "МАСШТАБ TextBox"
ЗАКАЗ - "ЗАКАЗ ComboBox"
ПОДРАЗД - "ПОДРАЗД ComboBox"
ТЕЛЕФОН - "ТЕЛЕФОН ComboBox"
N-ДОКУМЕНТА - "NДОКУМЕНТА TextBox"
ЛИСТ ИЗМЕНЕНИЯ - "ЛИСТ_ИЗМЕНЕНИЯ TextBox"
ИЗМЕНЕНИЕ - "ИЗМЕНЕНИЕ TextBox"
ШИФР ЗАКАЗА - "ШИФР_ЗАКАЗА ComboBox"
ДАТА СВ.ГРАФА - "дата_св_графа TextBox"
ДАТА УТВ. - "дата_утв TextBox"
ДАТА Н.КОНТР. - "дата_н_контр TextBox"
ДАТА Т.КОНТР. - "дата_т_контр TextBox"
ДАТА ПРОВ. - "дата_пров TextBox"
ДАТА РАЗР. - "дата_разр TextBox"
http://www.webfile.ru/487478
> bob
Взгляните мою программку Tacad на http://www.verzak.ru/progs.htm там все Ваши проблемы решены для основной надписи по ЕСКД. Дополнительные графы можно добавить.
Если конечно, Вам нужна программа как готовая программа.
Спасибо на хотелось бы иметь свою.
Спасибо на хотелось бы иметь свою.
Понятно. Ну... Бог в помощь.
Private Sub AcadDocument_BeginDoubleClick(ByVal PickPoint As Variant)
Set ssetObj = ThisDrawing.SelectionSets.Add(ThisDrawing.GetVariable("cdate"))
ssetObj.Select acSelectionSetPrevious
If ssetObj.Count > 1 Then 'если бъектов >=2 то функця properties
properties
GoTo 1
ElseIf ssetObj.Count = 0 Then 'если объектов 0 то выход
GoTo 1
End If
Set Object = ssetObj.Item(0)
Select Case Object.ObjectName
Case "AcDbBlockReference"
Select Case Object.Name
Case "stos"
stampedit
Case "mark_uz_1"
mark_uz
Case "mark_uz_2"
mark_uz
Case Else
blockedit
End Select
Case "AcDbText"
txtedit
Case "AcDbRotatedDimension"
dimedit
Case "AcDbAlignedDimension"
dimedit
Case "AcDb2LineAngularDimension"
dimedit
Case "AcDbDiametricDimension"
dimedit
Case "AcDbRadialDimension"
dimedit
Case Else
properties
End Select
1 ssetObj.Clear
End Sub
необходимо выгрузить arx-функцию обработки
двойного щелчка в файле acad.lsp
(arxunload "AcDblClkEdit" (setq n nil))
(arxload "acopm" (setq n nil))
Private Sub blockedit()запуск команды refedit
list = ThisDrawing.Object.InsertionPoint
list_txt = "(list " & Str(list(0)) & Str(list(1)) & Str(list(2)) & ")"
ThisDrawing.SendCommand "_refedit" & vbCr & list_txt & vbCr
End Sub
Private Sub txtedit() запуск собственной команды edt_text
ThisDrawing.SendCommand "pselect" & vbCr & "p" & vbCr & vbCr
ThisDrawing.SendCommand "edt_text" & vbCr
End Sub
Private Sub properties() запуск команды properties
ThisDrawing.SendCommand "pselect" & vbCr & "p" & vbCr & vbCr
ThisDrawing.SendCommand "properties" & vbCr
End Sub
А как это все работает???
Скопировал все это в один модуль и что дальше???
Private Sub blockedit() 'запуск команды refedit
list = ThisDrawing.Object.InsertionPoint
list_txt = "(list " & Str(list(0)) & Str(list(1)) & Str(list(2)) & ")"
ThisDrawing.SendCommand "_refedit" & vbCr & list_txt & vbCr
End Sub
Private Sub txtedit() 'запуск собственной команды edt_text
ThisDrawing.SendCommand "pselect" & vbCr & "p" & vbCr & vbCr
ThisDrawing.SendCommand "edt_text" & vbCr
End Sub
Private Sub properties() 'запуск команды properties
ThisDrawing.SendCommand "pselect" & vbCr & "p" & vbCr & vbCr
ThisDrawing.SendCommand "properties" & vbCr
End Sub
Private Sub AcadDocument_BeginDoubleClick(ByVal PickPoint As Variant)
Set ssetObj = ThisDrawing.SelectionSets.Add(ThisDrawing.GetVariable("cdate"))
ssetObj.Select acSelectionSetPrevious
If ssetObj.Count > 1 Then 'если бъектов >=2 то функця properties
properties
GoTo 1
ElseIf ssetObj.Count = 0 Then 'если объектов 0 то выход
GoTo 1
End If
Set Object = ssetObj.Item(0)
Select Case Object.ObjectName
Case "AcDbBlockReference"
Select Case Object.Name
Case "stos"
stampedit
Case "mark_uz_1"
mark_uz
Case "mark_uz_2"
mark_uz
Case Else
blockedit
End Select
Case "AcDbText"
txtedit
Case "AcDbRotatedDimension"
dimedit
Case "AcDbAlignedDimension"
dimedit
Case "AcDb2LineAngularDimension"
dimedit
Case "AcDbDiametricDimension"
dimedit
Case "AcDbRadialDimension"
dimedit
Case Else
properties
End Select
1 ssetObj.Clear
End Sub
> bob
Создаешь dvb-файл, например dblclick.dvb ,где в разделе AutoCAD objects->thisDrawing выбираешь событие BeginDoubleClick
вставляешь туда код:
Private Sub AcadDocument_BeginDoubleClick(ByVal PickPoint As Variant)
'вставляемый код:
'создается пустой набор с именем текущей даты (чтобы не встретился повторно)
Set ssetObj = ThisDrawing.SelectionSets.Add(ThisDrawing.GetVariable("cdate"))
'в набор ssetObj включаются выбранные тобой объекты (при двойном щелчке в
'AutoCAD'е выбираются объекты при помощи ручек и включаются
'в текущий (previous) набор объектов см. комманду "_select" в help'е)
ssetObj.Select acSelectionSetPrevious
'проверка количества выбранных объектов
'если объектов два и более то выполняется функция properties
If ssetObj.Count > 1 Then
properties
GoTo 1 'выход
'если объектов 0 то выход
ElseIf ssetObj.Count = 0 Then
GoTo 1
End If
'выбираем первый (он же и единственный) объект из набора
Set Object = ssetObj.Item(0)
'проверяем выбранный объект по типу
Select Case Object.ObjectName
'если блок то проверяем его имя
Case "AcDbBlockReference"
'если хочешь связать какую-то команду или функцию с конкретным блоком,
'то необходимо знать его имя
Select Case Object.Name
Case "stos" 'если имя блока "stos" то запускается функция stampedit
stampedit
Case "mark_uz_1" 'если имя блока "mark_uz_1" то запускается mark_uz и т.д.
'для каждого имени блока существует своя команда или функция
mark_uz
Case "mark_uz_2"
mark_uz
'если выбран блок с другим именем то выполняетя функция blockedit
Case Else
blockedit
End Select
'конец обработки блоков
'если выбран текст, то запускается функция txtedit
Case "AcDbText"
txtedit
'если выбран размер, то запускается dimedit
Case "AcDbRotatedDimension"
dimedit
Case "AcDbAlignedDimension"
dimedit
Case "AcDb2LineAngularDimension"
dimedit
Case "AcDbDiametricDimension"
dimedit
Case "AcDbRadialDimension"
dimedit
'если выбран другой примитив, то запускается функция properties
Case Else
properties
End Select
1 ssetObj.Clear 'перед выходом обязательно очистить набор
End Sub
'********************************
'********************************
'не забудь в declarations объявить переменные:
Public Object As Variant
Public ssetObj As AcadSelectionSet 'набор объектов
Public ObjectType As String 'тип объекта
'*******************************
'*******************************
'далее в этом же модуле (thisDrawing)
'создаешь необходимые тебе функции:
'функция запускающая в AutoCAD стандартную команду "_refedit"
Private Sub blockedit()
list = ThisDrawing.Object.InsertionPoint
list_txt = "(list " & Str(list(0)) & Str(list(1)) & Str(list(2)) & ")"
ThisDrawing.SendCommand "_refedit" & vbCr & list_txt & vbCr
End Sub
'функция запускающая в AutoCAD мою команду "edt_text"
Private Sub txtedit()
ThisDrawing.SendCommand "pselect" & vbCr & "p" & vbCr & vbCr
ThisDrawing.SendCommand "edt_text" & vbCr
End Sub
'функция запускающая в AutoCAD стандартную команду "_properties"
Private Sub properties()
ThisDrawing.SendCommand "pselect" & vbCr & "p" & vbCr & vbCr
ThisDrawing.SendCommand "properties" & vbCr
End Sub
'функция запускающая в AutoCAD мою команду "edt_dim"
Private Sub dimedit()
ThisDrawing.SendCommand "pselect" & vbCr & "p" & vbCr & vbCr
ThisDrawing.SendCommand "edt_dim" & vbCr
End Sub
'функция запускающая в AutoCAD мою команду "edt_stamp"
Private Sub stampedit()
ThisDrawing.SendCommand "pselect" & vbCr & "p" & vbCr & vbCr
ThisDrawing.SendCommand "edt_stamp" & vbCr
End Sub
'функция запускающая в AutoCAD мою команду "edt_mark_uz"
Private Sub mark_uz()
ThisDrawing.SendCommand "pselect" & vbCr & "p" & vbCr & vbCr
ThisDrawing.SendCommand "edt_mark_uz" & vbCr
End Sub
Шульга Илья что-то у меня не получается можно вам скинуть мой файлик
> bob
Можно, если небольшой объем
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Форумы CADUser → Программирование → VBA → Как связать диалоговое окно с блоком?
Форум работает на PunBB, при поддержке Informer Technologies, Inc