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

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

Программное создание мультивыноски

Ответ
Поиск в этой теме
Непрочитано 11.12.2008, 16:15 #1
Программное создание мультивыноски
Makswell
 
Инженер-строитель
 
Киров
Регистрация: 15.08.2007
Сообщений: 2,204

Всем привет.
Собственно требуется создать программно мультивыноску. Не знаю как?
У объекта ModelSpace есть метод AddMLeader.
У Полещука описание этого метода отсутствует.
Единственная инфа, которую нашёл, оказалась в справке:
Цитата:
AddMLeader method

Signature

RetVal = object.AddMLeader(pointsArray, leaderLineIndex)

Object

ModelSpace Collection, PaperSpace Collection, Block
The object or objects this method applies to.

pointsArray

Variant (three-element array of Doubles); input-only
The array of 3D WCS coordinates specifying the leader. You must provide at least two point to define the leader. The third point is optional.

leaderLineIndex

Long; input-only
Input index of the mleader cluster.

RetVal

MLeader object
The newly created MLeader object.
И пример оттуда же:
Цитата:
Sub Example_AddMLeader()
Dim oML As AcadMLeader
Dim points(0 To 14) As Double

' Define the leader points
points(0) = 1: points(1) = 1: points(2) = 0
points(3) = 1: points(4) = 2: points(5) = 0
points(6) = 2: points(7) = 2: points(8) = 0
points(9) = 3: points(10) = 2: points(11) = 0
points(12) = 4: points(13) = 4: points(14) = 0
Dim i As Long
Set oML = ThisDrawing.ModelSpace.AddMLeader(points, i)

End Sub
Пока ничего не понятно. Может кто расшифрует этот код применительно к лиспу, т.к. VBA я не знаю.
Просмотров: 34661
 
Непрочитано 11.12.2008, 17:44
1 | #2
ShaggyDoc

Thượng Tá Quân Đội Nhân Dân Việt Nam
 
Регистрация: 14.03.2005
44d32'44"С, 33d26'51"В
Сообщений: 13,381


Мультивыноска через LISP создается функцией
Код:
[Выделить все]
 
(vla-addmleader  активное_рабочее_пространство массив_точек_выноски  0)
Здесь самое сложное - создать safe-array из координат точек. Для простенькой односегментной выноски масив можно сделать примерно так:

Код:
[Выделить все]
(defun ru-mleader-coords-from-list (list_points / n pt pt_array)
(setq pt_array
             (vlax-make-safearray vlax-vbdouble (cons 1 (* 3 (length list_points))))
            n 0
      )
      (while (< n (length list_points))
        (setq pt (nth n list_points))
        (vlax-safearray-put-element pt_array (+ (* n 3) 1) (car pt))
        (vlax-safearray-put-element pt_array (+ (* n 3) 2) (cadr pt))
        (vlax-safearray-put-element pt_array (+ (* n 3) 3) (caddr pt))
        (setq n (1+ n))
      )
  pt_array
 )
Можно и более изячно, но так понятней.
Можно мультивыноску и добавить командой, например так (для двух точек):

Код:
[Выделить все]
 
(vl-cmdf "_.MLEADER"
      (trans (car list_points) 0 1)
       (trans (cadr list_points) 0 1)
       ""
)
Здесь list_points - обычный список координат из двух элементов.

После того, как объект мультивыноски создан, для него надо установить всё то множество свойств, чтобы он выглядел правильно. И, конечно, установить главное свойство - textstring.

Все эти действия спрятать в низкоуровневые функции, а на самом верху сделать 1-2 "конечных" функции, в которые передавать простые аргументы, например строку над выноской и под выноской.
ShaggyDoc вне форума  
 
Автор темы   Непрочитано 12.12.2008, 08:26
#3
Makswell

Инженер-строитель
 
Регистрация: 15.08.2007
Киров
Сообщений: 2,204


Спасибо большое.
Ещё один момент. Что значит последний аргумент метода AddMLeader? Который в Вашем коде равен 0.
Makswell вне форума  
 
Непрочитано 12.12.2008, 09:40
3 | #4
ShaggyDoc

Thượng Tá Quân Đội Nhân Dân Việt Nam
 
Регистрация: 14.03.2005
44d32'44"С, 33d26'51"В
Сообщений: 13,381


Надо научиться справкой по объектам. Делать надо так:
1. В Vlide вызвать справку
2. Выбрать ActiveX and VBA Reference
3. Выбрать в дереве Objects
4. Выбрать нужный объект, например Mleader object
5. Щелкнуть по нему и посмотреть. Причитать общее описание. Там есть ссылка
Цитата:
To create an mleader, use the AddMLeader method. To edit or query a leader, use the following methods and properties:
Это значит - сначала добавить объект, а потом воспользоваться его свойствами и методами.

Посмотреть Methods и Properties. Но сначала перейти на AddMleader. Там есть описание в стиле VBA


Код:
[Выделить все]
 
Signature 
RetVal = object.AddMLeader(pointsArray, leaderLineIndex) Object

ModelSpace Collection, PaperSpace Collection, Block
The object or objects this method applies to. pointsArray

Variant (three-element array of Doubles); input-only
The array of 3D WCS coordinates specifying the leader. You must provide at least two point to define the leader. The third point is optional. leaderLineIndex

Long; input-only
Input index of the mleader cluster. RetVal
MLeader object
The newly created MLeader object.
Если перевести его на LISP, то это означает:
1. Должна быть функция с именем vla-AddMleader.
2. Первым аргументом этой функции должно быть рабочее пространство, куда добавлять объект. В сигнатуре VBA нет такого аргумента, но есть object.AddMleader и перечень, чем может быть этот object.
3. Второй аргумент pointsArray (не LISP-список). Как его сделать я показал.
4. Третий загадочный аргумент - leaderLineIndex. Вспоминаем, что у мультивыноски может быть несколько выносных линий. Мы, для начала, делаем одну, а её индекс (номер) как раз и будет 0.
5. И возвратить эта функция должна созданный объект. Его надо запомнить в переменной, чтобы потом применять к нему методы или устанавливать свойства.
Например, чтобы занести текст, надо

Код:
[Выделить все]
(setq mleader_obj (vla-addmleader ...))
а потом где-то дальше

Код:
[Выделить все]
(vlax-put-property  mleader_obj 'textstring  "Это моя строка")
Имя свойства TextString мы нашли в перечне свойств. Можно было-бы и другой вариант написать

Код:
[Выделить все]
(vla-put-textstring mleader_obj  "Это моя строка")
Только на самом деле в надежных программах всё сложнее. Прежде чем установить свойство, надо проверить доступно ли оно. Да еще может и ошибка (по любым причинам) произойти при установке свойства. Поэтому лучше все это прятать в дополнительные функции, чтобы не повторять один и тот же код в разных программах.
ShaggyDoc вне форума  
 
Автор темы   Непрочитано 12.12.2008, 10:33
#5
Makswell

Инженер-строитель
 
Регистрация: 15.08.2007
Киров
Сообщений: 2,204


Ок. Понятно.
Ещё раз спасибо.

Добавлено:
Просто "Input index of the mleader cluster" я переводил как "Ввести индекс кластера мультилинии"
Makswell вне форума  
 
Непрочитано 13.12.2008, 00:37
#6
Кулик Алексей aka kpblc
Moderator

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


ShaggyDoc, позволю себе немного уточнить: достаточно набрать в консоли запущенной VLIDE vla-addmleader и тут же нажать Ctrl+F1. В подавляющем большинстве случаев (кроме особо тяжелых) открывается справка с уже открытым указанным методом.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 13.12.2008, 06:44
#7
ShaggyDoc

Thượng Tá Quân Đội Nhân Dân Việt Nam
 
Регистрация: 14.03.2005
44d32'44"С, 33d26'51"В
Сообщений: 13,381


Да, конечно. Можно и так. Но для этого надо написать, то есть знать, что существует метод AddLeader, и к нему надо добавить vla-. Ctrl+F1 очень удобно, когда надо уточнить что-то по известной функции.

Я специально описал самый длительный путь. А до более коротких вариантов уже можно додуматься.
ShaggyDoc вне форума  
 
Непрочитано 13.12.2008, 10:02
#8
Кулик Алексей aka kpblc
Moderator

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


Я его нашел случайно
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 13.12.2008, 11:15
#9
ShaggyDoc

Thượng Tá Quân Đội Nhân Dân Việt Nam
 
Регистрация: 14.03.2005
44d32'44"С, 33d26'51"В
Сообщений: 13,381


Ctrl+F1 в различных IDE обычно и вызывает справку по выделенному коду. А "более короткие" варианты - это просмотр веток Metods и Props, не заглядывая в Objects.
ShaggyDoc вне форума  
 
Непрочитано 05.12.2010, 00:36
#10
skkkk


 
Регистрация: 20.03.2008
Сообщений: 2,653


Подскажите, пожалуйста как при создании лиспом мультивыноски, задать в ее содержимом ЗНАЧЕНИЕ переменной, обозначенной в этом же лиспе
Код:
[Выделить все]
(defun c:ml (/ a b)

(setq a (getpoint "Укажите точку вставки  <Выход>: "))
(setq b (getreal "Введите размер уголка <Выход>: "))

(command "_mleader" a pause "_e" "0" "Уголок b")
Вот вместо "Уголок b" как вставить "Уголок 160", если на запрос значения "b" я ввожу "160"?

Последний раз редактировалось skkkk, 05.12.2010 в 03:35.
skkkk вне форума  
 
Непрочитано 05.12.2010, 00:43
#11
Кулик Алексей aka kpblc
Moderator

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


(command "_mleader" a pause "_e" "0" (strcat "Уголок " b))
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 05.12.2010, 01:11
#12
skkkk


 
Регистрация: 20.03.2008
Сообщений: 2,653


Алексей, ком строка ругается
Цитата:
Введите текст: ; ошибка: неверный тип аргумента: stringp 160.0
И еще: там не надо установить точность, чтоб было просто 160?

Добавлено: разобрался... (setq b (getstring...

Последний раз редактировалось skkkk, 05.12.2010 в 01:26.
skkkk вне форума  
 
Непрочитано 05.12.2010, 01:19
#13
Кулик Алексей aka kpblc
Moderator

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


Конвертируй в строку. Либо через rtos, либо через itoa, либо через vl-princ-to-string, либо в местной библиотеке бери соответствующую функцию
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 14.12.2010, 21:08
#14
skkkk


 
Регистрация: 20.03.2008
Сообщений: 2,653


Реально ли создать программно СТИЛЬ мультивыноски? Такой, как во вложении
Вложения
Тип файла: dwg
DWG 2007
Стиль мультивыноски.dwg (58.8 Кб, 2726 просмотров)
skkkk вне форума  
 
Непрочитано 15.12.2010, 15:04
#15
Дима_

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


А в чем там сложность?
__________________
Когда в руках молоток все вокруг кажется гвоздями.
Дима_ вне форума  
 
Непрочитано 15.12.2010, 15:16
#16
skkkk


 
Регистрация: 20.03.2008
Сообщений: 2,653


В том, что _mleaderstyle не запускается в прозрачном режиме, а vl я не знаю...
skkkk вне форума  
 
Непрочитано 15.12.2010, 15:33
1 | #17
Vildar

AutoCAD
 
Регистрация: 26.07.2007
Москва
Сообщений: 1,064


skkkk, стили мультивыносок хранятся в словаре ACAD_MLEADERSTYLE.
Там храняться объекты AcadMleaderStyle
Sub MLS()

Dim oDict As AcadDictionary
Set oDict = ThisDrawing.Dictionaries.Item("ACAD_MLEADERSTYLE")

Dim i As Long
For i = 0 To oDict.Count - 1
Dim oObj As AcadObject
Set oObj = oDict.Item(i)
If oObj.ObjectName = "AcDbMLeaderStyle" Then
Dim oMLS As AcadMLeaderStyle
Set oMLS = oObj
MsgBox "Name = " & oMLS.Name & vbCrLf & _
"Annotative = " & oMLS.Annotative & vbCrLf & _
"ContentType = " & oMLS.ContentType & vbCrLf & _
"LeaderLineType = " & oMLS.LeaderLineType, vbInformation, "MLeader Styles"
End If
Next i
Dim oNewMLS As AcadMLeaderStyle
Set oNewMLS = oDict.AddObject("TEST", "AcDbMLeaderStyle")

oNewMLS.LeaderLineType = acSplineLeader
Dim oCol As New AcadAcCmColor
oCol.ColorIndex = acBlue
oNewMLS.LeaderLineColor = oCol

Call ThisDrawing.SetVariable("CMLEADERSTYLE", "TEST")
Dim points(0 To 5) As Double
points(0) = 1: points(1) = 1: points(2) = 0
points(3) = 2: points(4) = 2: points(5) = 0
Dim oML As AcadMLeader
Set oML = ThisDrawing.ModelSpace.AddMLeader(points, i)
oML.TextString = "mleader created with " & vbCrLf & "style ""TEST"""

End Sub

Vildar вне форума  
 
Непрочитано 15.12.2010, 16:37
1 | #18
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Цитата:
Сообщение от skkkk Посмотреть сообщение
В том, что _mleaderstyle не запускается в прозрачном режиме, а vl я не знаю...
Переделай под себя
Код:
[Выделить все]
(defun mip-mleader-style-create ( mleaderstylename dimblk / mldrdict newldrstyle textcolor leadercolor objcolor)
;;; Создание стиля выноски MIP
;;;   mleaderstylename - имя стиля
;;;   dimblk - имя блока на конце (см переменную DIMBLK, например _Dot) или nil - нет
;;; Возвращает указатель на объект созданного стиля
;;;; Пример:   (mip-mleader-style-create "Skkk" nil)
;;; Установить стиль текущим
;;; (setvar "CMLEADERSTYLE" (vla-get-name (mip-mleader-style-create "Skkk" nil)))  
   
;;; Проверка наличия стиля
;;;(setq mleaderstylename "MIP")
;;;  (if (and (getvar "CMLEADERSTYLE") ;;;Автокад поддерживает мультивыноски
;;;         (setq tb-dic(DICTSEARCH (NAMEDOBJDICT) "ACAD_MLEADERSTYLE"))
;;;	 (not (member (cons 3 (strcase mleaderstylename))(DICTSEARCH (NAMEDOBJDICT) "ACAD_MLEADERSTYLE"))))
;;;    (progn )
;;;    )
(or dimblk (setq dimblk "_None"))
(setq mldrdict (vla-item (vla-get-dictionaries (vla-get-activedocument (vlax-get-acad-object))) "ACAD_MLEADERSTYLE"))
(setq newldrstyle (vlax-invoke mldrdict 'addobject mleaderstylename "AcDbMLeaderStyle"))
(setq textcolor acByBlock) ;;;Цвет текста
(setq leadercolor acByBlock) ;;;Цвет выноски
(setq objcolor (vla-getinterfaceobject
(vlax-get-acad-object)
(strcat "AutoCAD.AcCmColor." (substr (getvar "acadver") 1 2))
) ;_vla-getinterfaceobject
) ;_setq
(vla-put-ColorIndex objcolor textcolor)
(vla-put-TextColor newldrstyle objcolor)
(vla-put-ColorIndex objcolor leadercolor)
(vla-put-LeaderLineColor newldrstyle objcolor)
(if (not (tblobjname "block" dimblk))
       (progn
	 (setq textcolor (getvar "dimblk"))
         (if (VL-CATCH-ALL-ERROR-P(VL-CATCH-ALL-APPLY 'setvar (list "dimblk" dimblk)))
           (setvar "dimblk" (setq dimblk "_None"))
           )
	 (setvar "dimblk" (if (= textcolor "") "." textcolor))
	 )
       )  
(foreach item
(list
'("AlignSpace" 5.0)
'("Annotative" 0)
'("ArrowSize" 0.30) ;_Размер стрелки
(list "ArrowSymbol"  dimblk)
'("BitFlags" 0)
'("BlockConnectionType" 0)
'("BlockRotation" 0.0)
'("BlockScale" 1.0)
'("BreakSize" 0.125)
'("ContentType" 2)
'("Description"  "Стиль УП Минскинжпроект")
'("DoglegLength" 0.3)
'("DrawLeaderOrderType" 0)
'("DrawMLeaderOrderType" 1)
'("EnableBlockRotation" -1)
'("EnableBlockScale" -1)
'("EnableDogleg" -1)
'("EnableFrameText" 0)
'("EnableLanding" -1)
'("FirstSegmentAngleConstraint" 0)
'("LandingGap" 0.2)
'("LeaderLineType"  1)
;;;	'("LeaderLineTypeId" "ByBlock") ;_ "Continuous"
'("LeaderLineTypeId" "Continuous") ;_ "ByBlock"
'("LeaderLineWeight" 30) ;;;Вес линий выноски
'("MaxLeaderSegmentsPoints" 2)
'("ScaleFactor" 1.0)
'("SecondSegmentAngleConstraint"  0)
'("TextAlignmentType" 0)
'("TextAngleType" 0)
'("TextHeight" 1.5) ;_Высота текста
'("TextLeftAttachmentType" 3)
'("TextRightAttachmentType" 3)
'("TextString"  "")
'("TextStyle" "STANDARD") ;;;Текстовый стиль Должен существовать
)
;;;(terpri)(princ item)
(vlax-put-property newldrstyle (car item)(cadr item))
  )
  newldrstyle
  )

Пояснения про DImblk
Еще один вариант mip-mleader-style-create
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 17.06.2015 в 14:15. Причина: Ссылка на пост #44
VVA вне форума  
 
Непрочитано 18.02.2011, 11:49
#19
CAHTEXHuK

Инженер по теплоснабжению
 
Регистрация: 10.04.2010
РБ, г. Могилев
Сообщений: 25


может кто подсказать... такое дело... создаю достаточно простую мультивыноску с одной выноской по 2м точкам... она создается все вроде как хочу, только текст всегда оказывается слева от второй точки... а при минимальном движении акад уже меняет выноску с другой стороны... как должно быть... чета я не нашел метода, чтобы этот момент контролировать...
Код:
[Выделить все]
                    Set annotationObject = Nothing
                    insside = ThisDrawing.Utility.GetPoint(, vbCr & "Выберите точку вставки Выноски: ")
                    points(0) = Basepnt(0): points(1) = Basepnt(1):  points(2) = Basepnt(2)
                    points(3) = insside(0): points(4) = insside(1): points(5) = insside(2)
                    Set mlead = ThisDrawing.ModelSpace.AddMLeader(points, 1)
                    With mlead
                        .TextString = "текст"
                        .TextJustify = acAttachmentPointMiddleCenter
                    End With
CAHTEXHuK вне форума  
 
Непрочитано 18.02.2011, 13:25
1 | #20
Олег (jr.)

специалист по околачиванию грушевых деревьев
 
Регистрация: 14.09.2004
Pietari, Venäjä
Сообщений: 813


Цитата:
Сообщение от CAHTEXHuK Посмотреть сообщение
может кто подсказать... такое дело... создаю достаточно простую мультивыноску с одной выноской по 2м точкам... она создается все вроде как хочу, только текст всегда оказывается слева от второй точки... а при минимальном движении акад уже меняет выноску с другой стороны... как должно быть... чета я не нашел метода, чтобы этот момент контролировать...
Код:
[Выделить все]
                    Set annotationObject = Nothing
                    insside = ThisDrawing.Utility.GetPoint(, vbCr & "Выберите точку вставки Выноски: ")
                    points(0) = Basepnt(0): points(1) = Basepnt(1):  points(2) = Basepnt(2)
                    points(3) = insside(0): points(4) = insside(1): points(5) = insside(2)
                    Set mlead = ThisDrawing.ModelSpace.AddMLeader(points, 1)
                    With mlead
                        .TextString = "текст"
                        .TextJustify = acAttachmentPointMiddleCenter
                    End With
Так будет работать:
Код:
[Выделить все]
Option Explicit
'' Set in  Tools--> Options--> General--> Break on Unhandled Errors
Sub test()
Dim p1, p2
Dim vec(2) As Double
Dim pts(5) As Double
Dim i As Long
Dim util As AcadUtility
Dim space As AcadModelSpace
Dim ml As AcadMLeader
With ThisDrawing
Dim tile As Integer
tile = .GetVariable("TILEMODE")
Set util = .Utility
Set space = IIf(tile = 1, .ModelSpace, .PaperSpace)
End With

Do While True

With util
On Error Resume Next
p1 = .GetPoint(, vbCrLf & "Pick starting point(or press Enter to Exit):")
 If Err Then
         If StrComp(Err.Description, "User input is a keyword", 1) = 0 Then

             Err.Clear

Exit Sub
End If
End If


p2 = .GetPoint(p1, vbCrLf & "pick ending point:")
pts(0) = p1(0): pts(1) = p1(1): pts(2) = p1(2)
pts(3) = p2(0): pts(4) = p2(1): pts(5) = p2(2)

End With
Set ml = space.AddMLeader(pts, i) 'i=0
With ml
.ContentType = acMTextContent
If p2(0) > p1(0) Then
.TextJustify = acAttachmentPointMiddleLeft
vec(0) = 1: vec(1) = 0: vec(2) = 0
Else
vec(0) = -1: vec(1) = 0: vec(2) = 0
.TextJustify = acAttachmentPointMiddleRight
End If

.TextHeight = 4 '<-- text height
.ArrowheadSize = .TextHeight
.TextLineSpacingDistance = .TextHeight * 1.5
.DogLegged = True
.DoglegLength = .TextHeight
.SetDoglegDirection i, vec
.TextLeftAttachmentType = acAttachmentBottomOfTopLine
.TextRightAttachmentType = acAttachmentBottomOfTopLine
.TextString = "First Text Line\PSecond Text Line"

End With
Loop

End Sub
Олег (jr.) вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Программное создание мультивыноски

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Программное создание размерных стилей Кулик Алексей aka kpblc Программирование 89 08.04.2013 12:59
Программное создание PlotConfiguration Sleekka Программирование 2 17.09.2008 20:48
NanoСПДС gest Другие CAD системы 401 15.07.2008 14:50
Программное создание vport`ов Ax3 Программирование 10 29.08.2007 16:02