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

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

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

Ответ
Поиск в этой теме
Непрочитано 11.12.2008, 16:15
Программное создание мультивыноски
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 я не знаю.
Просмотров: 34671
 
Непрочитано 18.02.2011, 14:38
#21
CAHTEXHuK

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


Спасибо, несколько интересных моментов для себя отметил.
CAHTEXHuK вне форума  
 
Непрочитано 18.02.2011, 17:23
#22
Олег (jr.)

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


Цитата:
Сообщение от CAHTEXHuK Посмотреть сообщение
Спасибо, несколько интересных моментов для себя отметил.
замечательно
Олег (jr.) вне форума  
 
Непрочитано 12.08.2011, 10:56
#23
zvyagaaa


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


добрый день. Решил не создавать новую тему, а поднять старую, т.к. по той же проблеме.
Делаю утилитку на дельфи, чтобы можно было создавать мультивыноски. Все вроде бы работает нормально, но есть один вопрос. Подскажите куда копать. В общем, когда я создаю выноску, она по умолчанию имеет линию выноски слева от текста, а иногда мне нужно справа от текста ее крепить? Какой параметр за это отвечает?
Код:
[Выделить все]
MLeader:=AcadDocument1.ModelSpace.AddMLeader(FirstPoint,i);
MLeader.TextString:=tempstr;
MLeader.ArrowheadType :=acArrowNone;
Вот так я делаею выноску. Простую, с одной линией без изломов.
zvyagaaa вне форума  
 
Непрочитано 12.09.2011, 01:03
#24
Нефтепроводчик


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


Посоветуйте, как на LISPe создать стиль мультивыноски с помощью entmake?
В посте VVA приведен объектный способ создания стиля мвыноски, но он, на мой взгляд, сложнее программного. Во-вторых, не задает ряд важных свойств стиля мультивыноски:
- нельзя отключить "Автоматически добавлять полку",
- указать для мтекста некоторые параметры, например, скрытие заднего фона текста.
С помощью entget можно извлечь DXF коды для мультивыносок, например программой из справки:
Код:
[Выделить все]
(defun C:PRINTDXF ( )
 (setq ent (entlast))     ; Set ent to last entity.
 (setq entl (entget ent)) ; Set entl to association list of 
 ; last entity.
 (setq ct 0)              ; Set ct (a counter) to 0.
 (textpage)               ; Switch to the text screen.
 (princ "\nentget of last entity:")
 (repeat (length entl)    ; Repeat for number of members in list:
 (print (nth ct entl))  ; Print a newline, then each list 
 ; member.
 (setq ct (1+ ct))      ; Increments the counter by one.
 )
 (princ)                  ; Exit quietly.
)
Как получить DXF коды именно для стилей мультивыносок?
В справке AutoCAD даны перечни кодов для стилей мультивыносок 4 типов (включая общий). Если мвыноска предусматривается с мтекстом, то нужно использовать MLeaderStyle Context Data Group Codes?
Настораживает, что некоторые номера кодов для разных стилей имеют разное назначение (например, 90 Property Override Flag для Common MLeaderStyle Group Codes и 90 Text Color для MLeaderStyle Context Data Group Codes).
Помогите разобраться.
Нефтепроводчик вне форума  
 
Непрочитано 12.09.2011, 02:02
#25
Кулик Алексей aka kpblc
Moderator

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


Нефтепроводчик, стиль мультивыноски и объект мультивыноски - немного разные вещи. И, откровенно говоря, я бы не стал работать со стилями через DXF - объектная модель все же более удобна во многих случаях.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 12.09.2011, 09:23
#26
Oliver_88

"ценный кадр"
 
Регистрация: 02.12.2010
Сообщений: 115
<phrase 1=


Цитата:
Сообщение от Нефтепроводчик
как на LISPe создать стиль мультивыноски с помощью entmake?
Можно так.
Код:
[Выделить все]
 (setq style
       (entmakex '(
		   (0 . "MLEADERSTYLE")
		   (5 . "125")
		   (100 . "AcDbMLeaderStyle")
		   (179 . 2)
		   (170 . 2)
		   (171 . 1)
		   (172 . 0)
		   (90 . 2)
		   (40 . 0.0)
		   (41 . 0.0)
		   (173 . 1)
		   (91 . -1056964608)
		   (92 . -2)
		   (290 . 1)
		   (42 . 2.0)
		   (291 . 1)
		   (43 . 8.0)
		   (3 . "Standard")
		   (44 . 4.0)
		   (300 . "")
		   (174 . 1)
		   (178 . 1)
		   (175 . 1)
		   (176 . 0)
		   (93 . -1056964608)
		   (45 . 4.0)
		   (292 . 0)
		   (297 . 0)
		   (46 . 4.0)
		   (94 . -1056964608)
		   (47 . 1.0)
		   (49 . 1.0)
		   (140 . 1.0)
		   (293 . 1)
		   (141 . 0.0)
		   (294 . 1)
		   (177 . 0)
		   (142 . 1.0)
		   (295 . 0)
		   (296 . 0)
		   (143 . 3.75)
		   (271 . 0)
		   (272 . 9)
		   (273 . 9)
		   )
		 )
      )
(setq data_list
       (dictsearch (namedobjdict) "ACAD_MLEADERSTYLE")
      )
(setq data_name (cdr(assoc -1 data_list)))
(dictadd data_name
	 "имя нового стиля"
	 style
	 )
Oliver_88 вне форума  
 
Непрочитано 12.09.2011, 09:25
#27
Кулик Алексей aka kpblc
Moderator

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


Oliver_88, а теперь попробуй промоделировать следующую ситуацию: ты создал стиль, а пользователь взял да и поменял там пару-тройку настроек. Задача - вернуть все в нормальный вид.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 12.09.2011, 11:08
#28
VVA

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


Цитата:
Сообщение от Нефтепроводчик Посмотреть сообщение
приведен объектный способ создания стиля мвыноски, но он, на мой взгляд, сложнее программного. Во-вторых, не задает ряд важных свойств стиля мультивыноски:
У меня изначально так же стиль создавался entmake'ом. Но в процессе работы столкнулся с тем, что при сохранении и открытии чертежа стали возникать ошибки в чертеже. После их исправления исчезал стиль мультивыноски. Я так и не разобрался, что нужно поправить в entmak'е. Вот код. Текстовый стиль МИП_ГОСТ должен существовать.
Код:
[Выделить все]
(VL-CATCH-ALL-APPLY '(lambda(  / tb tb-dic xr) 
;;Добавляем стиль мультивыноски 
(if (and (getvar "CMLEADERSTYLE") ;_Автокад поддерживает мультивыноски
         (setq tb-dic(DICTSEARCH (NAMEDOBJDICT) "ACAD_MLEADERSTYLE")) ;_Существует словарь мультивыносок
	 (not (member (cons 3 "MIP")(DICTSEARCH (NAMEDOBJDICT) "ACAD_MLEADERSTYLE")))); Отсутствует стиль мультивыноски MIP
  (progn
(if (not (tblobjname "block" "_None"))
       (progn
	 (setq tb (getvar "dimblk"))
	 (setvar "dimblk" "_None")
	 (setvar "dimblk" (if (= tb "") "." tb))
	 )
       )    
(setq tb (list
           '(0 . "MLEADERSTYLE")
            '(100 . "AcDbMLeaderStyle")
            '(170 . 2)
            '(171 . 1)
            '(172 . 0)
            '(90 . 2)
            '(40 . 0.0)
            '(41 . 0.0)
            '(173 . 1)
            '(91 . -1056964608)
            '(92 . -2)
            '(290 . 1)
            '(42 . 0.15)
            '(291 . 1)
            '(43 . 0.1)
            '(3 . "Mip-STYLE")
            '(44 . 0.5)
            '(300 . "")
            '(174 . 6)
            '(178 . 6)
            '(175 . 1)
            '(176 . 0)
            '(93 . -1056964608)
            '(45 . 1.5)
            '(292 . 0)
            '(297 . 0)
            '(46 . 4.0)
            '(94 . -1056964608)
            '(47 . 1.0)
            '(49 . 1.0)
            '(140 . 1.0)
            '(293 . 1)
            '(141 . 0.0)
            '(294 . 1)
            '(177 . 0)
            '(142 . 1.0)
            '(295 . 1)
            '(296 . 0)
            '(143 . 0.125)
           (cons 342 (tblobjname "style" "МИП_ГОСТ")) ;_Стиль
           
;;; Символ на конце
;;;    	    (cons 341 (cdr
;;;			(assoc 330
;;;			       (entget
;;;				 (tblobjname "block" "_None") ; _dot
;;;				 ) ;_ end of entget
;;;			       ) ;_ end of assoc
;;;			))
           )
       )
(if (setq xr (entmakex tb))
  (entmod (append tb-dic(list (cons 3 "MIP")(cons 350 xr))))
  )
))
(setq tb (cdr(assoc 350(member (cons 3 "MIP")(DICTSEARCH (NAMEDOBJDICT) "ACAD_MLEADERSTYLE")))))
(setq tb nil xr nil tb-dic nil )                       
))
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 12.09.2011, 11:29
#29
Oliver_88

"ценный кадр"
 
Регистрация: 02.12.2010
Сообщений: 115
<phrase 1=


Кулик Алексей aka kpblc, с ходу не получается. Ковырятся надо.
Oliver_88 вне форума  
 
Непрочитано 13.09.2011, 00:47
#30
Нефтепроводчик


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


Спасибо, буду дальше разбираться.
Нефтепроводчик вне форума  
 
Непрочитано 18.09.2011, 11:56
#31
Oliver_88

"ценный кадр"
 
Регистрация: 02.12.2010
Сообщений: 115
<phrase 1=


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
Oliver_88, а теперь попробуй промоделировать следующую ситуацию: ты создал стиль, а пользователь взял да и поменял там пару-тройку настроек. Задача - вернуть все в нормальный вид.
Вроде бы вернул.
Код:
[Выделить все]
 ;(test1 "имя нового стиля")
(defun test1 (st_name /)
  (setq	lst1
	 '(
	   (0 . "MLEADERSTYLE")
	   (100 . "AcDbMLeaderStyle")
	   (179 . 2)
	   (170 . 2)
	   (171 . 1)
	   (172 . 0)
	   (90 . 2)
	   (40 . 0.0)
	   (41 . 0.0)
	   (173 . 1)
	   (91 . -1056964608)
	   (92 . -2)
	   (290 . 1)
	   (42 . 2.0)
	   (291 . 1)
	   (43 . 8.0)
	   (3 . "Standard")
	   (44 . 4.0)
	   (300 . "")
	   (174 . 1)
	   (178 . 1)
	   (175 . 1)
	   (176 . 0)
	   (93 . -1056964608)
	   (45 . 4.0)
	   (292 . 0)
	   (297 . 0)
	   (46 . 4.0)
	   (94 . -1056964608)
	   (47 . 1.0)
	   (49 . 1.0)
	   (140 . 1.0)
	   (293 . 1)
	   (141 . 0.0)
	   (294 . 1)
	   (177 . 0)	
	   (142 . 1.0)
	   (295 . 0)
	   (296 . 0)
	   (143 . 3.75)
	   (271 . 0)
	   (272 . 9)
	   (273 . 9)
	  )
  )
  (setq	null_name
	 (cdr
	   (assoc 330
		  (entget
		    (cdr
		      (assoc 330
			     (entget
			       (cdr
				 (assoc	330
					(entget
					  (tblobjname "BLOCK" "*Model_Space")
					)
				 )
			       )
			     )
		      )
		    )
		  )
	   )
	 )
  )
  (entmod
    (test
      (dictsearch
	(cdr
	  (assoc -1
		 (dictsearch (namedobjdict) "ACAD_MLEADERSTYLE")
		 )
	  )
	st_name
	)
      lst1
      null_name
      )
    )
  (princ)
)
(defun test (lst lst1 null_name / el)
  (cond
    (
     (member (caar lst) (list -1 0 5 102 330))
     (cons (car lst) (test (cdr lst) lst1 null_name))
     )
    (
     (setq el (assoc (caar lst) lst1))
     (cons el (test (cdr lst) (cdr lst1) null_name))
     )
    (
     lst
     (cons
       (cons
	 (caar lst)
	 null_name
	 )
       (test (cdr lst) lst1 null_name)
       )
     )
    )
  )
Oliver_88 вне форума  
 
Непрочитано 30.11.2011, 17:51
#32
Apelsinov

Проектировщик ВК. LISP-любитель.
 
Регистрация: 15.12.2003
Москва
Сообщений: 1,186
<phrase 1=


у меня вопрос, похожий на тот что в #23
модифицирую выноску

Код:
[Выделить все]
 (vlax-invoke ml_obj 'SetLeaderLineVertices 0 list_2points)
; где ml_obj - объект мультивыноски
; list_2points - список координат двух точек этой выноски, типа (list 0.0 0.0 0.0 -1.0 1.0 0.0)
так вот, при любых координатах в list_2points линия выноски оказывается слева от текста. Как это регулировать можно?
__________________
apel.fas
Apelsinov вне форума  
 
Непрочитано 30.11.2011, 19:18
#33
Олег (jr.)

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


Выдерни нужное из этого кода
см. SetdoglegDirection
Код:
[Выделить все]
 (defun C:MLF (/ acsp adoc col dht ent mlead p1 p2 pline pt1 pt2 ptarr txt)
  (vl-load-com)
  (or adoc
      (setq adoc
	     (vla-get-activedocument
	       (vlax-get-acad-object)
	       )
	    )
      )
  (if (and
	(= (getvar "tilemode") 0)
	(= (getvar "cvport") 1)
	)
    (setq acsp (vla-get-paperspace adoc))
    (setq acsp (vla-get-modelspace adoc))
    )

  (setq	col (vla-getinterfaceobject
	      (vlax-get-acad-object)
	      (strcat "autocad.accmcolor."
		      (vl-princ-to-string (atoi (getvar "acadver")))))
	)
  (while (setq ent (entsel "\n >> Выбрать полилинию >> \n"))
    (progn
      (setq pline (vlax-ename->vla-object (car ent))
	    )
      (setq txt
		(strcat
		  "%<\\AcObjProp Object(%<\\_ObjId "
		  (itoa (vla-get-objectid pline))
		  ">%).Layer \\f \"%tc4\">%"
		  )

	    txt	(strcat	txt
			"\\P"
			"%<\\AcObjProp Object(%<\\_ObjId "
			(itoa (vla-get-objectid pline))
			">%).Length \\f \"%lu2%ps[L=,м]%zs8\">%"))

      (setq p1 (vlax-curve-getclosestpointto pline (cadr ent))
	    p2 (getpoint p1 "\nТочка полочки выноски >> \n")
	    )
      (setq ptarr (vlax-make-variant
		    (vlax-safearray-fill
		      (safearray vlax-vbdouble '(0 . 5))
		      (apply 'append (list p1 p2))))
	    )

      (setq mlead (vla-addmleader acsp ptarr 0))
      (vla-put-contenttype mlead acMTextContent)
      (vla-put-textheight mlead(getvar "dimtxt"))
      (vla-put-landinggap mlead 0.09)
      (vla-put-textstring mlead txt)
;;;(vla-put-layer mlead (vla-get-layer pline));; <-- не работает потому что в имени слоя некорректный символ (диаметр)
     (vla-put-doglegged mlead :vlax-true)
      (vla-put-dogleglength mlead 0.05)
      ;;borrowed from LeeMac:
      (vla-setdoglegdirection
	mlead
	0
	(vlax-3D-point
	  (list
	    (if	(<= (car p1) (car p2))
	      1
	      -1)
	    0
	    0
	    )
	  )
	)
      (if (>= (car p2) (car p1))
      (vla-put-TextJustify mlead acAttachmentPointMiddleLeft)
      (vla-put-TextJustify mlead acAttachmentPointMiddleRight)
	)
      (vla-put-TextLeftAttachmentType mlead acAttachmentBottomOfTopLine)
      (vla-put-TextRightAttachmentType mlead acAttachmentBottomOfTopLine)
      (vla-put-leaderlineweight mlead acLnWt025)
      (vla-put-leadertype mlead 1)
      (vla-put-colorindex col 256)
      (vla-put-truecolor mlead col)
      (vla-put-leaderlinecolor mlead col)

      )
    )
  (vl-catch-all-apply
    (function (lambda ()
		(vlax-release-object col)
		)
	      )
    )
  (vla-regen adoc acactiveviewport)
  (princ)
)
(prompt "\n")
(prompt "\t\t<<< Ввести MLF для старта программы\t>>> ")
(princ)
Олег (jr.) вне форума  
 
Непрочитано 01.12.2011, 11:39
#34
Apelsinov

Проектировщик ВК. LISP-любитель.
 
Регистрация: 15.12.2003
Москва
Сообщений: 1,186
<phrase 1=


Цитата:
Сообщение от Олег (jr.) Посмотреть сообщение
Выдерни нужное из этого кода
см. SetdoglegDirection
у меня получается частично решить проблему с помощью
Код:
[Выделить все]
 (vla-put-TextAttachmentDirection ml_obj 0)
; где ml_obj - объект мультивыноски
В этом случае акад сам выбирает положение выносной линии относительно полки выноски.
Но как и в случае с SetdoglegDirection, это немного не то. Интересует изменение положения полки выноски, относительно выносной линии. То есть если мы задаем точки p1 и p2, то нужно чтобы выносная линия была отрисована как p1-p2, а полка выноски отображалась справа или слева, в зависимости от угла наклона линии выноски.

Offtop: Я извиняюсь за, возможно, глупые вопросы по поводу свойств объектов, но у меня не работает нормально справка по объектной модели.
__________________
apel.fas
Apelsinov вне форума  
 
Непрочитано 01.12.2011, 23:07
#35
Олег (jr.)

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


Попробуй так, только рнемного с геометрией надо повозиться,
чтобы точно пересчитывать точки всех линий мультилидера
Код:
[Выделить все]
 (vl-load-com)
(defun C:Demo (/ acsp adoc axss  mlead p1 p2 p3  ptarr ss str_text)
  
  (or adoc
      (setq adoc
	     (vla-get-activedocument
	       (vlax-get-acad-object)
	       )
	    )
      )
  (if (and
	(= (getvar "tilemode") 0)
	(= (getvar "cvport") 1)
	)
    (setq acsp (vla-get-paperspace adoc))
    (setq acsp (vla-get-modelspace adoc))
    )
(setvar 'qtextmode 0)
(setvar 'orthomode 0)
        (setq p1 (getpoint  "\nPick arrow point >> \n")
	    p2 (getpoint p1 "\nPick start of text line >> \n")
	    )
  (setvar 'orthomode 1)
   (setq   p3 (getpoint p2 "\nPick end of text line >> \n"))
          (setvar 'orthomode 0)
            (setq str_text "Blah\nBlah\nBlah")
      (setq ptarr (vlax-make-variant
		    (vlax-safearray-fill
		      (safearray vlax-vbdouble '(0 . 5))
		      (apply 'append (list p1 p2 ))))
	    )

      (setq mlead (vla-addmleader acsp ptarr 0))
      (vla-put-leadertype mlead 1)
      (vla-put-contenttype mlead acMTextContent)
      (vla-put-textheight mlead 0.28);<--change  text height here
      (vla-put-landinggap mlead 0.07)
      (vla-put-textstring mlead str_text)

     (vla-put-doglegged mlead :vlax-true)
     (vla-put-dogleglength mlead 0.01)
      ;;borrowed from Lee Mac:
      (vla-setdoglegdirection
	mlead
	0
	(vlax-3D-point
	  (list
	    (if	(<= (car p2) (car p3))
	      1
	      -1)
	    0
	    0
	    )
	  )
	)
      (if (>= (car p3) (car p2))
      (vla-put-TextJustify mlead acAttachmentPointMiddleLeft)
      (vla-put-TextJustify mlead acAttachmentPointMiddleRight)
	)
      
      (vla-put-TextLeftAttachmentType mlead 7);acAttachmentBottomLine- 7

      (vla-put-TextRightAttachmentType mlead 7);acAttachmentMiddleOfTop - 1;;acAttachmentMiddleOfBottom - 5

     (vla-put-TextFrameDisplay mlead :vlax-false) ;<-- to display text frame :vlax-true
  
      (vla-put-leaderlineweight mlead -3)

  (princ)
)
Олег (jr.) вне форума  
 
Непрочитано 21.02.2012, 18:18
1 | #36
VVA

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


Из тем How to set new MLeaderStyle properties и Modify a MultiLeader text style, leader style
Код:
[Выделить все]
;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-;;
;;; Xander http://www.theswamp.org/index.php?topic=40944.0
;;;	<function>cadcoder:createmultileaderstyle</function>
;;;	<summary>Creates a MultiLeader style in accordance with GT standards</summary>
;;;	<param name="$stylename">Multileader Style name</param>
;;;	<param name="$fontname">Textstyle name to use</param>
;;;	 
;;;	<returns>Nothing</returns>

;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-;;
(DEFUN cadcoder:createmultileaderstyle ($stylename $fontstyle / $styleentity lst)
    (DEFUN createmultileader (data / dic obj)
        ;;If we can reference the Mleaderstyle dictionary object
        ;;and the proposed style name doesn't exist
        ;;and the entmake was successful
        (IF (AND (SETQ dic (DICTSEARCH (NAMEDOBJDICT) "ACAD_MLEADERSTYLE"))
                 (NOT (DICTSEARCH (SETQ dic (CDR (ASSOC -1 dic))) "GTSTD"))
                 (SETQ obj (ENTMAKEX data))
            )
            ;;Add the style to the dictionary
            (DICTADD dic (CDR (ASSOC 3 data)) obj)
        )
    )
    ;;If the text style doesn't exist, exit
    (IF (= nil (TBLSEARCH "STYLE" $fontstyle))
        (EXIT)
    )
    ;;Create the Mleader DXF style list
    (SETQ lst
             (LIST
                 (CONS 0 "MLEADERSTYLE")
                 (CONS 100 "AcDbMLeaderStyle")
                 (CONS 179 2) ;Text Attachment Point
                 (CONS 170 2) ;Content Type
                 (CONS 171 1) ;Draw MLeaderOrder Type
                 (CONS 172 0) ;DrawLeaderOrderType
                 (CONS 90 0) ;MaxLeader Segments
                 (CONS 40 0.0) ;First Segment Angle Constraint
                 (CONS 41 0.0) ;Second Segment Angle Constraint
                 (CONS 173 1) ;Leader Line Type
                 (CONS 91 (colour->mleaderstylecolour 1)) ;Leader Line Color (Red)
                 (CONS 340 (TBLOBJNAME "LTYPE" "ByLayer")) ;Leader Line Type
                 (CONS 92 -1) ;Leader Line weight
                 (CONS 290 1) ;Enable Landing
                 (CONS 42 1.5) ;Landing Gap
                 (CONS 291 1) ;Enable Dog Leg
                 (CONS 43 3) ;Dog Leg Length
                 (CONS 3 $stylename) ;MLeaderDescription
                 (CONS 341 (CDR (ASSOC 330 (ENTGET (TBLOBJNAME "BLOCK" "GT-ARR7"))))) ;Leader ArrowID
                 (CONS 44 1) ;Arrow Head Size
                 (CONS 300 "") ;Default Text contents
                 (CONS 342 (TBLOBJNAME "STYLE" $fontstyle)) ;MTextStyleID
                 (CONS 174 1) ;Text Left Attachment Type
                 (CONS 178 1) ;Text Right Attachment Type
                 (CONS 175 1) ;Text Angle Type
                 (CONS 176 0) ;Text Alignment Type
                 (CONS 93 (colour->mleaderstylecolour 3)) ;Text Color
                 (CONS 45 0) ;Text Height
                 (CONS 292 0) ;Enable Frame Text
                 (CONS 297 1) ;Text Always Left Justify
                 (CONS 46 0.18) ;Align Space
                 (CONS 142 1.0) ;Scale
                 (CONS 295 1) ;Overright Property Value
                 (CONS 296 0) ;Is Annotative
                 (CONS 143 0.0) ;Break Gap Size
                 (CONS 271 0) ;Text Attachment Direction (0 = Horizontal, 1 = Vertical)
                 (CONS 272 9) ;Bottom Text Attachment Direction (9 = Center, 10 = Underline & Center)
                 (CONS 273 9) ;Top Text Attachment Direction (9 = Center, 10 = Underline & Center)
             )
    )
    ;;Create the MLeader Style dictionary
    (createmultileader lst)
    ;;Set the new style as current
    (SETVAR "CMLEADERSTYLE" $stylename)
    (PRINC)
)
 
;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-;;
;|
<function>color->mleaderstylecolor</function>
<summary>Converts an ACI color to an mleader color.</sumary>
<param name="c">ACI color</param>
 
<returns>Mleader color expressed as a 24bit value.</returns>
|;
 ;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-;;
(DEFUN colour->mleaderstylecolour (c)
    ;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-;;
    ;|
    <function>color:rgb->true</function>
    <summary>Converts an RGB color to a true color</sumary>
    <param name="r">Red color value</param>
    <param name="g">Green color value</param>
    <param name="b">Blue color value</param>
    <returns>Color value</returns>
    |;
    ;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-;;
 
    (DEFUN color:rgb->true (r g b)
        (+
            (LSH (FIX r) 16)
            (LSH (FIX g) 8)
            (FIX b)
        )
    )
    (COND
        ((LISTP c)
         (+ -1040187392 (APPLY 'color:rgb->true c))
        )
        ((= 0 c)
         -1056964608
        )
        ((= 256 c)
         -1073741824
        )
        ((< 0 c 256)
         (+ -1023410176 (color:rgb->true 0 0 c))
        )
    )
)
 
 
;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-;;
;|
<function>mleaderstylecolor->color</function>
<summary>Converts an MLeader color to the True or ACI color.</sumary>
<param name="c">Mleader color</param>
 
<returns>True or ACI color.</returns>
|;
 ;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-;;
(DEFUN mleaderstylecolour->colour (c)
 
    ;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-;;
    ;|
    <function>color:true->rgb</function>
    <summary>Converts an True color to a RGB color</sumary>
    <param name="c">True color to convert</param>
    <returns>Color value</returns>
    |;
    ;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-;;
    (DEFUN color:true->rgb (c)
        (LIST
            (LSH (LSH (FIX c) 8) -24)
            (LSH (LSH (FIX c) 16) -24)
            (LSH (LSH (FIX c) 24) -24)
        )
    )
    (IF (< 0 (LOGAND 16777216 c))
        (LAST (color:true->rgb c))
        (IF (EQUAL '(0 0 0) (SETQ c (color:true->rgb c)))
            256
            c
        )
    )
)
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 23.10.2012, 20:48
#37
Profan


 
Регистрация: 25.12.2005
Москва
Сообщений: 13,627


Для VVA.
Как с помощью кода, описанного в сообщении #18, создать стиль мультивыноски с символом стрелки "Закрашенная замкнутая" ("Closed filled")?
Выражения
(mip-mleader-style-create "СТРОЙЗАДАНИЕ" ".")
(setvar "CMLEADERSTYLE" (vla-get-name (mip-mleader-style-create "СТРОЙЗАДАНИЕ" ".")))
выдают ошибку:
Команда: ; ошибка: Ошибка Automation. Ключ не найден
Profan вне форума  
 
Непрочитано 19.12.2012, 10:46
#38
VVA

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


Profan, Извини, как-то пропустил твой вопрос
Значение dimblk - одно из возможных значений переменной _DIMBLK
В твоем случае
Код:
[Выделить все]
(mip-mleader-style-create "СТРОЙЗАДАНИЕ" "_Dot")
Миниатюры
Нажмите на изображение для увеличения
Название: dimblk.png
Просмотров: 258
Размер:	61.3 Кб
ID:	92941  
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 19.12.2012, 12:06
#39
Profan


 
Регистрация: 25.12.2005
Москва
Сообщений: 13,627


VVA, спасибо, но я разобрался еще в октябре.
Profan вне форума  
 
Непрочитано 17.06.2015, 08:03
#40
Alikme


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


Код VVA выдает такую ошибку: "; ошибка: Ошибка Automation. Проблемы при загрузке приложения", причем на домашнем компьютере с автокадом 2014 - всё работает... При этом стиль успевает создать, а настройки стиля - нет. С чем может быть такое связано?
Alikme вне форума  
Ответ
Вернуться   Форум 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