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

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Как сделать блок выноски?

Как сделать блок выноски?

Ответ
Поиск в этой теме
Непрочитано 23.01.2020, 12:09 #1
Как сделать блок выноски?
sae.prc
 
Регистрация: 22.10.2019
Сообщений: 18

Добрый день, уважаемые форумчане. Идея следующая (хотя наверно и не новая):при вставке выноски, происходит запрос на выбор блока, далее запрос на необходимый для вывода атрибут (если выноска двухуровневая, то возможно запрос на вывод в разных строках разных свойств).
Как такое реализовать, по средствам полей и VBA или может быть как то по другому?
Прикладное применение для такой выноски в моем личном случае: при вставке блока в чертеж я задаю атрибуты и у меня заготовлены шаблоны (несколько штук) для вывода определенных свойств (например имя вентсистемы/тип вентилятора, или только имя вентсистемы, или наименование вентилятора/электрическая мощность и тд), а мне бы хотелось сделать универсальную выноску, которая по запросу выводит нужные мне свойства.
Буду признателен, если кто нибудь откликнется на мою идею.
Просмотров: 1488
 
Непрочитано 23.01.2020, 13:21
#2
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 37,269


Не понял вопроса. Чего надо в результате-то? Мультивыноску создать? Так в справке есть примеры.
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 23.01.2020, 13:48
#3
sae.prc


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


Все верно создать выноску, НО с диалоговым окном при вставке "укажи нужный блок", затем "укажи нужный для вывода атрибут для верхней строки" и "укажи нужный для вывода атрибут для нижней строки"
sae.prc вне форума  
 
Непрочитано 23.01.2020, 14:05
#4
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 37,269


И в чем собственно затык?
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 23.01.2020, 14:13
#5
sae.prc


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


Для человека знающего я думаю ни в чем, я же себя отношу к не совсем знающим данную область человеку, по этому и обратился с просьбой о помощи
sae.prc вне форума  
 
Непрочитано 23.01.2020, 14:21
#6
DMSskop


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


Если блок отдельно с атрибутом, то можно создать выноску вручную в ней задать поля со ссылкой и значений этих блоков.
DMSskop вне форума  
 
Автор темы   Непрочитано 24.01.2020, 07:29
#7
sae.prc


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


Уточню, блоки разные, атрибуты разные, но выноска должна быть одна (не несколько типов с привязкой к конкретным атрибутам), которая "спросит" в виде диалогового окна или в командной строке у какого конкретно блока и какие конкретно атрибуты я хочу вывести.
sae.prc вне форума  
 
Непрочитано 24.01.2020, 07:55
#8
Boxa

КЖ; C#
 
Регистрация: 03.11.2005
Санкт-Петербург
Сообщений: 2,186


Ничто не ново под луной: https://forum.dwg.ru/showthread.php?p=1694247
__________________
_бложиг
Boxa вне форума  
 
Непрочитано 24.01.2020, 09:24
1 | #9
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 7,950


Цитата:
Сообщение от sae.prc Посмотреть сообщение
Уточню, блоки разные, атрибуты разные, но выноска должна быть одна (не несколько типов с привязкой к конкретным атрибутам), которая "спросит" в виде диалогового окна или в командной строке у какого конкретно блока и какие конкретно атрибуты я хочу вывести.
VBA вам не чужд, судя по постам - так выбираете вставку блока (GetEntity), получаете список его атрибутов, создаете форму - куда выводите список атрибутов выбранного блока. Над списком метку - где пишете типа: Выберите атрибут для N-ой строки. И по событию двойного клика для ListBox увеличиваете номер строки в метке и сохраняете в коллекции информацию о добавленном атрибуте. Внизу формы кнопки - "Создать" и "Отмена". При нажатии первой создается выноска, и туда заносятся поля на выбранные атрибуты. Большая часть примеров кода можно найти здесь на форуме, не говоря уже об мировой паутине.
Сергей812 вне форума  
 
Автор темы   Непрочитано 24.01.2020, 11:45
#10
sae.prc


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


Цитата:
Сообщение от Сергей812 Посмотреть сообщение
VBA вам не чужд, судя по постам - так выбираете вставку блока (GetEntity), получаете список его атрибутов, создаете форму - куда выводите список атрибутов выбранного блока. Над списком метку - где пишете типа: Выберите атрибут для N-ой строки. И по событию двойного клика для ListBox увеличиваете номер строки в метке и сохраняете в коллекции информацию о добавленном атрибуте. Внизу формы кнопки - "Создать" и "Отмена". При нажатии первой создается выноска, и туда заносятся поля на выбранные атрибуты. Большая часть примеров кода можно найти здесь на форуме, не говоря уже об мировой паутине.
Спасибо за направление мыслей, буду пытаться реализовать задумку
sae.prc вне форума  
 
Непрочитано 24.01.2020, 12:06
#11
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 7,950


с точки зрения юзабилити даже лучше не метку, а второй список под первым - куда будет выводиться выбранные атрибуты в порядке выбора: т.е. как они потом будут расположены на выноске. И кнопка сброса набора - если промахнулись с атрибутами, то чтобы блок снова не выбирать - коллекцию выбранных атрибутов и список второй очистили и все.
Сергей812 вне форума  
 
Непрочитано 27.01.2020, 17:21
#12
gizmo_zx

Проектировщик ЭО,ЭМ, ЭОС
 
Регистрация: 18.07.2007
Нижний Новгород
Сообщений: 234
<phrase 1= Отправить сообщение для gizmo_zx с помощью Skype™


Код:
[Выделить все]
Sub multigrups()
    Dim SsetObj As AcadSelectionSet, Entry As AcadEntity
    Dim tobj As AcadText, mtobj As AcadMText, tStr As String, sNum As String, bobj As AcadBlockReference
    Dim ListNum(7) As String
    Dim TxtStr() As Variant, tmpTxtStr() As Variant, InTable As Boolean, Check As Boolean, scbcn As Boolean
    Dim minRow As Long, maxRow As Long, minCol As Long, maxCol As Long
    Dim Table As AcadTable, row As Long, column As Long, cobj As AcadCircle, pnt As ACAD_POINT
    Dim rowMin As Long, rowMax As Long, colMin As Long, colMax As Long
    Dim w3 As Double, w4 As Double, ert As Boolean
    Dim w1(0 To 2) As Double, w2(0 To 2) As Double, color As New AcadAcCmColor, scbc As New AcadAcCmColor
    
    ''''
    Dim bloks_names, bloks_names2, atr_names As String
    'bloks_names2 = InputBox("Введите имя блока:", , "")
    'atr_names = InputBox("Введите имя атрибута:", , "")
    ''''
    

            Call ClearSelectionSets
            Set SsetObj = ThisDrawing.SelectionSets.Add("SETNumber")
            SsetObj.SelectOnScreen
            
Dim kol, kol_a As Integer
kol = 0
For Each Entry In SsetObj
kol = kol + 1
Next
Dim mas_kol(), date_at, name_at As String
ReDim mas_kol(kol, 2)

kol_a = 1
For Each Entry In SsetObj

            bloks_names = ""
            If Entry.ObjectName = "AcDbBlockReference" Then
                bloks_names = Entry.EffectiveName
            Else
'                If oBlkRef.isblock Then
'                    bloks_names = oBlkRef.Name
'                End If
            End If
            

            'If bloks_names <> "" And bloks_names = bloks_names2 Then
                If Entry.ObjectName = "AcDbText" Or Entry.ObjectName = "AcDbMText" Or Entry.ObjectName = "AcDbBlockReference" Then
                    Select Case Entry.ObjectName
'                    Case "AcDbText"
'                        Set tobj = Entry
'                        tStr = tobj.FieldCode
'                        Xpos = tobj.InsertionPoint(0): Ypos = tobj.InsertionPoint(1)
'                        If tobj.Height > THgt Then THgt = tobj.Height
'                    Case "AcDbMText"
'                        Set mtobj = Entry
'                        tStr = mtobj.FieldCode
'                        Xpos = mtobj.InsertionPoint(0): Ypos = mtobj.InsertionPoint(1)
'                        If mtobj.Height > THgt Then THgt = mtobj.Height
                    Case "AcDbBlockReference"
                        Set bobj = Entry
                                                
                        attr = bobj.GetAttributes()
                        varAtt = bobj.GetAttributes
                        For i = 0 To UBound(varAtt)
                            Set oAtt = varAtt(i)
                            name_at = oAtt.TagString
                            date_at = oAtt.TextString
                            
                            If name_at = "GRUPS_N" Then
                                mas_kol(kol_a, 1) = date_at
                            End If
                            If name_at = "KABEL" Then
                                mas_kol(kol_a, 2) = date_at
                            End If
                        Next i

                    End Select

                End If
                'End If 'bloks_names <> ""
NextEntry:
            kol_a = kol_a + 1
            Next
    SsetObj.Delete
    
'''

'mas_kol(kol, 2)
Dim temp As Variant
'Dim razmer, razmer_l, pr As Integer
'Dim mstr2() As Variant
''ReDim mstr2(razmer)
'razmer_l = LBound(mstr)
'razmer = UBound(mstr)
''ReDim sort_mass_rez(razmer)
'ReDim mstr2(razmer)

Do
pr = 0
For i = kol To kol - 1
   If mas_kol(i + 1, 1) < mas_kol(i, 1) Then
        
        temp = mas_kol(i, 1)
        mas_kol(i, 1) = mas_kol(i + 1, 1)
        mas_kol(i + 1, 1) = temp
        
        temp = mas_kol(i, 2)
        mas_kol(i, 2) = mas_kol(i + 1, 2)
        mas_kol(i + 1, 2) = temp
    pr = 1
   End If
Next i
Loop While pr = 1
    
'& vbCrLf

    
''''
' мультивыноска
''''
Dim varPt, nxtPt As Variant

'ThisDrawing.Utility.GetPoint oEnt, varPt, "Выбрать полилинию (Enter для выхода из цикла): "
varPt = ThisDrawing.Utility.GetPoint(, "multigrups_ctr_v" & vbCr & "Точка начала выноски:")
'If Err Then
'Err.Clear
'Exit Do
'End If
'On Error GoTo 0

Dim mas_kol3() As String
ReDim mas_kol3(kol, 2)
Dim i3, sovp As Integer

i3 = 1
For i = 0 To kol
sovp = 0
    For i2 = 0 To kol
        If mas_kol(i, 1) <> "" And mas_kol(i, 1) = mas_kol3(i2, 1) Then
            sovp = 1
        End If
    Next i2
    
    If sovp = 0 And mas_kol(i, 1) <> "" Then
        mas_kol3(i3, 1) = mas_kol(i, 1)
        mas_kol3(i3, 2) = mas_kol(i, 2)
        i3 = i3 + 1
    End If
    
    
    
Next i

Do
pr = 0
For i = 1 To kol - 1
   If mas_kol3(i + 1, 1) < mas_kol3(i, 1) Then
        
        temp = mas_kol3(i, 1)
        mas_kol3(i, 1) = mas_kol3(i + 1, 1)
        mas_kol3(i + 1, 1) = temp
        
        temp = mas_kol3(i, 2)
        mas_kol3(i, 2) = mas_kol3(i + 1, 2)
        mas_kol3(i + 1, 2) = temp
    pr = 1
   End If
Next i
Loop While pr = 1



temp = ""
''.PutInClipboard
''Clipboard.GetText
'temp = GetOffClipboard
'
'
'
'
'
'
'
'    If temp <> "" And temp <> " " Then
'        temp = temp & vbCrLf
'    End If
'
'    If temp = " " Or temp = "  " Then
'        temp = ""
'    End If


For i = 0 To kol
    If mas_kol3(i, 1) <> "" Then
        temp = temp + " " + mas_kol3(i, 1) + " " + mas_kol3(i, 2) & vbCrLf
    End If
Next i


'Dim nxtPt As Variant
nxtPt = ThisDrawing.Utility.GetPoint(, vbCr & "Точка полки текста:")
Dim ptArr(5) As Double
ptArr(0) = varPt(0): ptArr(1) = varPt(1): ptArr(2) = 0#
ptArr(3) = nxtPt(0): ptArr(4) = nxtPt(1): ptArr(5) = 0#
Dim oLeader As AcadMLeader
Dim c As Long
c = 0
Dim oSpace As AcadBlock

With ThisDrawing
If .ActiveSpace = acModelSpace Then
Set oSpace = .ModelSpace
Else
Set oSpace = .PaperSpace
End If
End With
Set oLeader = oSpace.AddMLeader(ptArr, c)
oLeader.ContentType = acMTextContent
oLeader.TextString = CStr(temp)
    
    
End Sub
gizmo_zx вне форума  
 
Автор темы   Непрочитано 27.01.2020, 22:16
#13
sae.prc


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


Добрый день, спасибо за код, выскочила ошибка (картинка во вложении)
Миниатюры
Нажмите на изображение для увеличения
Название: Аннотация 2020-01-28 001452.jpg
Просмотров: 21
Размер:	132.5 Кб
ID:	222482  
sae.prc вне форума  
 
Непрочитано 27.01.2020, 23:08
#14
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 7,950


это пример кода, откуда нужны лишь отдельные фрагменты для вашей задачи... ClearSelectionSets - пользовательский метод, он и не нужен - блоки то поштучно выбираете, а не группой.
Сергей812 вне форума  
 
Непрочитано 28.01.2020, 07:59
#15
gizmo_zx

Проектировщик ЭО,ЭМ, ЭОС
 
Регистрация: 18.07.2007
Нижний Новгород
Сообщений: 234
<phrase 1= Отправить сообщение для gizmo_zx с помощью Skype™


Private Sub ClearSelectionSets()
For i = 1 To ThisDrawing.SelectionSets.Count
ThisDrawing.SelectionSets.Item(0).Delete
Next
End Sub
gizmo_zx вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Как сделать блок выноски?

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Помогите сделать блок с атрибутами в котором можно перемещать блок с атрибутами вместе и атрибуты отдельно и их поворачивать по отдельности otsva Динамические блоки 4 08.10.2019 21:35
Как для выноски сделать Textmask Russik AutoCAD 12 09.07.2019 13:11
Можно ли сделать чтобы команда "Выбрать подобные" спрашивала "территорию" на которой надо выделить блок Шмель Динамические блоки 8 06.08.2014 14:11
Как сделать блок уникальным? +Alex+ Программирование 6 25.05.2011 15:55
Как сделать динамический блок из нескольких солид тел? Scrubber Динамические блоки 5 22.09.2010 22:29