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

Makswell · 11.12.2008, 16:15

Всем привет.
Собственно требуется создать программно мультивыноску. Не знаю как?
У объекта 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 я не знаю.

100k · 17.06.2015, 08:59

так в Tekla есть мультивыноска

VVA · 17.06.2015, 09:19

Alikme, А на какой версии Автокада выдает ошибку?

Alikme · 17.06.2015, 10:26

Так же в 2014-ом!
Я подозреваю вот это место, но не могу понять что не так...

Код:

[Выделить все]

 (setq objcolor (vla-getinterfaceobject
(vlax-get-acad-object)
(strcat "AutoCAD.AcCmColor." (substr (getvar "acadver") 1 2))
) ;_vla-getinterfaceobject

VVA · 17.06.2015, 14:13

Проверь этим вариантом.

Код:

[Выделить все]

 
(defun mip-mleader-style-create (mleaderstylename
                                 dimblk         /
                                 mldrdict       newldrstyle
                                 textcolor      leadercolor
                                 objcolor
                                )
;;; Программное создание мультивыноски   http://forum.dwg.ru/showthread.php?t=27965&page=3
;;;   mleaderstylename - имя стиля
;;;   dimblk - имя блока на конце (см переменную DIMBLK ниже, например _Dot) или nil - нет
;;; Для стиля берется текущий текстовый стиль из переменной "TEXTSTYLE"
;;; Для задания своего стиля заменить (getvar "TEXTSTYLE") на имя своего стиля. Текстовый стиль должен существовать!!!!
;;; Возвращает указатель на объект созданного стиля
;;; Пример:
;;;  (mip-mleader-style-create "Test-O90" "_OPEN90")
;;;  (mip-mleader-style-create "Test-O91" "_Dot")
;;;  (mip-mleader-style-create "Test-O92" nil)  
;;; Установить стиль текущим
;;; (setvar "CMLEADERSTYLE" (vla-get-name (mip-mleader-style-create "Skkk" nil)))  
  
;;; Возможные варианты значений Dimblk
;;;;         "_ARCHTICK" 	= Architectural tick
;;;;         "_BOXBLANK" 	= Box
;;;;         "_BOXFILLED" 	= Box filled
;;;;         "_CLOSED" 	= Closed
;;;;         "_CLOSEDBLANK"= Closed blank
;;;;         "." 		= none
;;;;         "_DATUMBLANK" = Datum triangle
;;;;         "_DATUMFILLED"= Datum triangle filled
;;;;         "_DOT"	 = Dot
;;;;         "_DOTBLANK" 	= Dot blank
;;;;         "_DOTSMALL" 	= Dot small
;;;;         "_SMALL" 	= Dot small blank
;;;;         "_INTEGRAL" 	= Integral
;;;;         "_NONE" 	= None
;;;;         "_OBLIQUE" 	= Oblique
;;;;         "_OPEN" 	= Open
;;;;         "_OPEN30" 	= Open 30
;;;;         "_ORIGIN" 	= Origin indicator
;;;;         "_ORIGIN2" 	= Origin indicator 2
;;;;         "_OPEN90" 	= Right angle

;;; Проверка наличия стиля
;;;(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 )
;;;    )

;;; http://www.theswamp.org/index.php?topic=40944.0
  ;|
;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-;;
;;; 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
        )
    )
)
|;
  ;|
(setq result "NO")
(if (setq dict (dictsearch (namedobjdict) "ACAD_MLEADERSTYLE"))
(foreach x dict 
(if (and (= (car x) 3) (eq (strcase (cdr x)) (strcase "Normal")))
(setq result "YES")
)
)
)
(if (= result "NO")(progn
(setq *doc* (vla-get-activedocument (vlax-get-acad-object)))
(setq mldrdict (vla-item (vla-get-dictionaries *doc*) "ACAD_MLEADERSTYLE"))
(setq newldrstyle (vlax-invoke mldrdict 'addobject "Normal" "AcDbMLeaderStyle"))
(setq txtcol 7 ldrcol 8)
(setq colorObj (vla-getinterfaceobject (vlax-get-acad-object) "AutoCAD.AcCmColor.17"))
(vla-put-ColorIndex colorObj txtcol)
(vla-put-TextColor newldrstyle colorObj)
(vla-put-ColorIndex colorObj ldrcol)
(vla-put-LeaderLineColor newldrstyle colorObj)
(vlax-put-property newldrstyle 'AlignSpace 0.18)
(vlax-put-property newldrstyle 'Annotative 0)
(vlax-put-property newldrstyle 'ArrowSize 10.0)
(vlax-put-property newldrstyle 'BlockConnectionType 0)
(vlax-put-property newldrstyle 'BlockRotation 0.0)
(vlax-put-property newldrstyle 'BlockScale 10.0)
(vlax-put-property newldrstyle 'BreakSize 6.0)
(vlax-put-property newldrstyle 'ContentType 2)
(vlax-put-property newldrstyle 'Description "Normal")
(vlax-put-property newldrstyle 'DoglegLength 6.0)
(vlax-put-property newldrstyle 'DrawLeaderOrderType 0)
(vlax-put-property newldrstyle 'DrawMLeaderOrderType 1)
(vlax-put-property newldrstyle 'EnableBlockRotation -1)
(vlax-put-property newldrstyle 'EnableBlockScale -1)
(vlax-put-property newldrstyle 'EnableDogleg -1)
(vlax-put-property newldrstyle 'EnableFrameText 0)
(vlax-put-property newldrstyle 'EnableLanding -1)
(vlax-put-property newldrstyle 'FirstSegmentAngleConstraint 0)
(vlax-put-property newldrstyle 'LandingGap 4.0)
(vlax-put-property newldrstyle 'LeaderLineType 1)
(vlax-put-property newldrstyle 'LeaderLineTypeId "Continuous")
(vlax-put-property newldrstyle 'LeaderLineWeight -1)
(vlax-put-property newldrstyle 'MaxLeaderSegmentsPoints 9)
(vlax-put-property newldrstyle 'name "Normal")
(vlax-put-property newldrstyle 'ScaleFactor 1.0)
(vlax-put-property newldrstyle 'SecondSegmentAngleConstraint 0)
(vlax-put-property newldrstyle 'TextAlignmentType 1)
(vlax-put-property newldrstyle 'TextAngleType 1)
(vlax-put-property newldrstyle 'TextHeight 6.0)
(vlax-put-property newldrstyle 'TextLeftAttachmentType 1)
(vlax-put-property newldrstyle 'TextRightAttachmentType 1)
(vlax-put-property newldrstyle 'TextString "")
(vlax-put-property newldrstyle 'TextStyle "SSE")
))
(command "._cmleaderstyle" "Normal")

|;

  ;|
(vl-load-com)
(defun mleadercreate (/ *doc* mldrdict newldrstyle) 
    (setq *doc* (vla-get-activedocument (vlax-get-acad-object))) 
    (setq mldrdict (vla-item (vla-get-dictionaries *doc*) "ACAD_MLEADERSTYLE")) 
    (setq newldrstyle (vlax-invoke mldrdict 'addobject "CM_Mleader" "AcDbMLeaderStyle")) 
    (setq txtcol 0 ldrcol 0) 
    (setq colorObj (vla-getinterfaceobject (vlax-get-acad-object) "AutoCAD.AcCmColor.17")) 
    (vla-put-ColorIndex colorObj txtcol) 
    (vla-put-ColorIndex colorObj ldrcol) 
    (vlax-put-property newldrstyle 'AlignSpace 5.0) 
;; Leader format
    (vlax-put-property newldrstyle 'LeaderLineType 1) 
    (vla-put-LeaderLineColor newldrstyle colorObj) 
;    (vlax-put-property newldrstyle 'LeaderLineTypeId "Bylayer" )
    (vlax-put-property newldrstyle 'LeaderLineWeight -2)
    (vlax-put-property newldrstyle 'ArrowSymbol "_dot") 
    (vlax-put-property newldrstyle 'ArrowSize 0.125)
    (vlax-put-property newldrstyle 'BreakSize 0.099609375) 
;; Leader Structure
    (vlax-put-property newldrstyle 'MaxLeaderSegmentsPoints 0)
    (vlax-put-property newldrstyle 'FirstSegmentAngleConstraint 0) 
    (vlax-put-property newldrstyle 'SecondSegmentAngleConstraint 0) 
    (vlax-put-property newldrstyle 'EnableLanding -1)
    (vlax-put-property newldrstyle 'EnableDogleg -1) 
    (vlax-put-property newldrstyle 'DoglegLength -2.0) 
    (vlax-put-property newldrstyle 'Annotative 0)
    (vlax-put-property newldrstyle 'ScaleFactor 1.0) 
;; Content
    (vlax-put-property newldrstyle 'ContentType 0) 
    (vlax-put-property newldrstyle 'TextString "") 
    (vlax-put-property newldrstyle 'TextStyle (getvar "textstyle")) 
    (vlax-put-property newldrstyle 'TextAngleType 0) 
    (vla-put-TextColor newldrstyle colorObj)
    (vlax-put-property newldrstyle 'TextHeight 0.2)  
    (vlax-put-property newldrstyle 'TextAlignmentType 0) 
    (vlax-put-property newldrstyle 'EnableFrameText 0) 
    (vlax-put-property newldrstyle 'TextAttachmentDirection 0)
    (vlax-put-property newldrstyle 'TextBottomAttachmentType 0)  
    (vlax-put-property newldrstyle 'TextLeftAttachmentType 2) 
    (vlax-put-property newldrstyle 'TextRightAttachmentType 3) 
    (vlax-put-property newldrstyle 'TextTopAttachmentType 0) 
    (vlax-put-property newldrstyle 'LandingGap 0.029296875) 
    (vlax-put-property newldrstyle 'BlockConnectionType 0) 
    (vlax-put-property newldrstyle 'BlockRotation 0.0) 
    (vlax-put-property newldrstyle 'BlockScale 1.0) 
    (vlax-put-property newldrstyle 'DrawLeaderOrderType 0) 
    (vlax-put-property newldrstyle 'DrawMLeaderOrderType 1) 
    (vlax-put-property newldrstyle 'EnableBlockRotation -1) 
    (vlax-put-property newldrstyle 'EnableBlockScale -1) 
    (vlax-put-property newldrstyle 'Description "CM_Mleader") 
    (vlax-put-property newldrstyle 'name "CM_Mleader") 
)
|;
  (or dimblk (setq dimblk "_None"))
  (setq mldrdict
         (vla-item (vla-get-dictionaries
                     (vla-get-activedocument (vlax-get-acad-object))
                   ) ;_ end of vla-get-dictionaries
                   "ACAD_MLEADERSTYLE"
         ) ;_ end of vla-item
  ) ;_ end of setq
  (if (vl-catch-all-error-p
        (vl-catch-all-apply
          '(lambda ()
             (setq newldrstyle
                    (vlax-invoke
                      mldrdict
                      'addobject
                      mleaderstylename
                      "AcDbMLeaderStyle"
                    ) ;_ end of vlax-invoke
             ) ;_ end of setq
           ) ;_ end of lambda
        ) ;_ end of VL-CATCH-ALL-APPLY
      ) ;_ end of VL-CATCH-ALL-ERROR-P
    (vlax-ename->vla-object
      (cdr
        (assoc
          350
          (member
            (cons 3
                  (MIP-MLEADER-STYLE-CREATE-DXF mleaderstylename dimblk)
            ) ;_ end of cons
            (dictsearch (namedobjdict) "ACAD_MLEADERSTYLE")
          ) ;_ end of member
        ) ;_ end of assoc
      ) ;_ end of cdr
    ) ;_ end of vlax-ename->vla-object
    (progn
      (setq textcolor acbyblock)
;;;Цвет текста
      (setq leadercolor acbyblock)
;;;Цвет выноски
      (setq objcolor (vla-getinterfaceobject
                       (vlax-get-acad-object)
                       (strcat "AutoCAD.AcCmColor."
                               (substr (getvar "acadver") 1 2)
                       ) ;_ end of strcat
                     ) ;_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))
              ) ;_ end of VL-CATCH-ALL-ERROR-P
            (setvar "dimblk" (setq dimblk "_None"))
          ) ;_ end of if
          (setvar "dimblk"
                  (if (= textcolor "")
                    "."
                    textcolor
                  ) ;_ end of if
          ) ;_ end of setvar
        ) ;_ end of progn
      ) ;_ end of if
      (foreach item
                    (list
                      '("AlignSpace" 5.0)
                      '("Annotative" 0)
                      '("ArrowSize" 0.30) ;_Размер стрелки
                      (list "ArrowSymbol" dimblk)
                      '("BitFlags" 0)
                      
;;;("Block"  "")
                      '
                       ("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" "")
                      (list "TextStyle" (getvar "TEXTSTYLE"))
                    ) ;_ end of list
;;;(terpri)(princ item)
        (vlax-put-property newldrstyle (car item) (cadr item))
      ) ;_ end of foreach
      newldrstyle
    ) ;_ end of progn
  ) ;_ end of if
)
(defun mip-mleader-style-create-dxf (mleaderstylename dimblk)
;;;mleaderstylename - string mleader style name
;;;dimblk - Arrow Symbol block name (or nil - none)
;;;;          "."                = Closed FIlled
;;;;         "_ARCHTICK" 	= Architectural tick
;;;;         "_BOXBLANK" 	= Box
;;;;         "_BOXFILLED" 	= Box filled
;;;;         "_CLOSED" 	= Closed
;;;;         "_CLOSEDBLANK"= Closed blank
;;;;         "_DATUMBLANK" = Datum triangle
;;;;         "_DATUMFILLED"= Datum triangle filled
;;;;         "_DOT"	 = Dot
;;;;         "_DOTBLANK" 	= Dot blank
;;;;         "_DOTSMALL" 	= Dot small
;;;;         "_SMALL" 	= Dot small blank
;;;;         "_INTEGRAL" 	= Integral
;;;;         "_NONE" 	= None
;;;;         "_OBLIQUE" 	= Oblique
;;;;         "_OPEN" 	= Open
;;;;         "_OPEN30" 	= Open 30
;;;;         "_ORIGIN" 	= Origin indicator
;;;;         "_ORIGIN2" 	= Origin indicator 2
;;;;         "_OPEN90" 	= Right angle
;;;Use
;;; (mip-mleader-style-create-dxf "test-DOT" "_Dot")
;;; (mip-mleader-style-create-dxf "test-Open30" "_Open30")
;;; (mip-mleader-style-create-dxf "test-ClosedFilled" ".") ;_Closed filled
;;; (mip-mleader-style-create-dxf "test-nil" nil) ;_Not
  (vl-catch-all-apply
    '(lambda (/ tb tb-dic xr)
       ;;Добавляем стиль мультивыноски 
       (if
         (and
           (getvar "CMLEADERSTYLE") ;_Автокад поддерживает мультивыноски
           (setq tb-dic (dictsearch (namedobjdict) "ACAD_MLEADERSTYLE")) ;_Существует словарь мультивыносок
           (not (member (cons 3 mleaderstylename)
                        (dictsearch (namedobjdict) "ACAD_MLEADERSTYLE")
                ) ;_ end of member
           ) ;_ end of not
         )                                        ; Отсутствует стиль мультивыноски MIP
          (progn
;;;	(if (not (tblobjname "block" "_None"))
;;;	       (progn
;;;		 (setq tb (getvar "dimblk"))
;;;		 (setvar "dimblk" "_None")
;;;		 (setvar "dimblk" (if (= tb "") "." tb))
;;;		 )
;;;	       )
            (or dimblk (setq dimblk "_None"))
            (if (eq dimblk "")
              (setq dimblk ".")
            ) ;_ end of if
            (if (and dimblk (not (tblobjname "block" dimblk)))
              (progn
                (setq tb (getvar "dimblk"))
                (if
                  (vl-catch-all-error-p
                    (vl-catch-all-apply 'setvar (list "dimblk" dimblk))
                  ) ;_ end of VL-CATCH-ALL-ERROR-P
                   (setvar "dimblk" (setq dimblk "_None"))
                ) ;_ end of if
                (setvar "dimblk"
                        (if (null tb)
                          "."
                          tb
                        ) ;_ end of if
                ) ;_ end of setvar
              ) ;_ end of progn
            ) ;_ end of if
            (setq tb
                   (vl-remove-if
                     'null
                     (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")
                       (if (tblobjname "BLOCK" dimblk)
                         (cons
                           341
                           (cdr (assoc 330 (entget (tblobjname "BLOCK" dimblk)))
                           ) ;_ end of CDR
                         ) ;_Leader ArrowID
                         nil
                       ) ;_ end of if
                       '(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" (getvar "TEXTSTYLE"))) ;_Стиль

;;; Символ на конце
;;;    	    (cons 341 (cdr
;;;			(assoc 330
;;;			       (entget
;;;				 (tblobjname "block" "_None") ; _dot
;;;				 ) ;_ end of entget
;;;			       ) ;_ end of assoc
;;;			))
                     ) ;_ end of list

                   ) ;_ end of vl-remove-if
            ) ;_ end of setq
            (if (setq xr (entmakex tb))
              (dictadd (cdr (assoc -1 tb-dic)) mleaderstylename xr)
;;;  (entmod (append tb-dic(list (cons 3 "MIP")(cons 350 xr))))
            ) ;_ end of if
          ) ;_ end of progn
       ) ;_ end of if
;;;(setq tb (cdr(assoc 350(member (cons 3 "MIP")(DICTSEARCH (NAMEDOBJDICT) "ACAD_MLEADERSTYLE")))))
;;;(setq tb nil xr nil tb-dic nil )                       
     ) ;_ end of lambda
  ) ;_ end of VL-CATCH-ALL-APPLY
  mleaderstylename
)

Там в комментариях все что находил в интернете по этой теме. Если не интересует, можно удалить

Alikme · 17.06.2015, 14:53

http://www.arch-pub.com/2016-breaks-2009_10732354.html Такая же проблема походу как у меня, конфликт с AutoCAD 2015, пишет что помогла установка AutoCAD 2016... Код сейчас проверю

----- добавлено через ~10 мин. -----
defun mip-mleader-style-create-dxf - работает, а defun mip-mleader-style-create вылетает на том же месте...

Код:

[Выделить все]

 (vla-getinterfaceobject (vlax-get-acad-object)
                       (strcat "AutoCAD.AcCmColor."
                               (substr (getvar "acadver") 1 2)
                       ) ;_ end of strcat
                     )

VVA · 17.06.2015, 16:29

Я код из #44 проверял на 2015. 2014 у меня нет. 2016 так же стоит, но пока так, для интересу.

Alikme · 17.06.2015, 21:31

В 2015-ом у меня так же работает, а с 2014 пока никак. Поставлю 2016 - проверю, заработает в 2014 или нет.

ring · 16.05.2017, 00:43

А кто-нибудь подскажет как при создании стиля мультивыноски задать коэффициент перекрытия 1.2 (по умолчанию устанавливается 1.5) при установлении свойства TextBackgroundFill в True?

Нефтепроводчик · 16.05.2017, 00:56

Цитата:

Сообщение от ring

А кто-нибудь подскажет как при создании стиля мультивыноски задать коэффициент перекрытия 1.2 (по умолчанию устанавливается 1.5) при установлении свойства TextBackgroundFill в True?

Пример использования:

Код:

[Выделить все]

 
(setq ml_obj (vlax-ename->vla-object name))
	  (vlax-put-property ml_obj 'LandingGap (* 0.5 scale cor_sc))
	  (vlax-put-property ml_obj 'TextString coord)
	  (vlax-put-property ml_obj 'TextHeight (* hight_txt scale cor_sc))
	  (vlax-put-property ml_obj 'TextBackgroundFill cond_bm)
	  (setq	ml_ent	(vlax-vla-object->ename ml_obj)
		ml_list	(entget ml_ent)
		ml_list	(subst (cons 141 factor_bm) (assoc 141 ml_list) ml_list)
	  )

factor_bm - это и есть коэффициент скрытия заднего фона (factor background mask)
В общем, через точечную пару (141 ___)

Khasan_Mamaev · 20.05.2017, 17:12

Если кому то интересно, могу показать свое решение для проставления мультивыносок по блокам. Скрипт написан на IronPython в Dynamo, но может работать без Динамо, главное чтобы в системе был установлен АйронПайтон

Код:

[Выделить все]

[PYTHON]import System
from System import Array

from math import pi
app = System.Runtime.InteropServices.Marshal.GetActiveObject("Autocad.Application")
aDoc = app.ActiveDocument
mSp = aDoc.ModelSpace

sset = aDoc.PickfirstSelectionSet

def ptA(p,x1,y1):
	return Array[float]([p[0], p[1], p[2], p[0]+x1, p[1]+y1, p[2]])

def getAttr(x):
	return x.GetAttributes()

def tagText(x):
	return [x.TagString, x.TextString]

layText = IN[2]
mast = IN[3]
tag = IN[4]
obNam = 'AcDbBlockReference'

pos1 = IN[5]
pos2 = IN[6]
rot = IN[7]

x0 = IN[8]
y0 = IN[9]
if pos1 == False and pos2 == False:
	x1 = x0
	y1 = y0
elif pos1 == False and pos2 == True:
	x1 = x0
	y1 = -y0
elif pos1 == True and pos2 == True:
	x1 = -x0
	y1 = -y0
elif pos1 == True and pos2 == False:
	x1 = -x0
	y1 = y0

k = mast/100.0

allTable = []
for j in sset:
	if  j.ObjectName == obNam:#layText in j.Layer
		attr = getAttr(j)
		points = ptA(j.InsertionPoint,x1*k,y1*k)
		lead = mSp.AddMLeader(points, 0)
		for i in attr:
			if tagText(i)[0] == tag:
				lead.TextString = tagText(i)[1]
	if rot == True:
		lead.Rotate(j.InsertionPoint, pi/2)[/PYTHON]

Theodor · 20.07.2017, 03:15

Коллеги!
Заморочился с вопросом, можно ли силами VBA создать мультивыноску и задать ей стиль уже имеющийся в чертеже?

проверить наличие стиля в чертеже вроде удалось

Код:

[Выделить все]

Dim objDict As AcadDictionary
 Dim objTMP As AcadObject
 Dim StLeader As AcadMLeaderStyle
 Dim StLeaderAbsent As Boolean
 Dim Ind As Long
 StLeaderAbsent = True
 Set objDict = ThisDrawing.Dictionaries.Item("ACAD_MLEADERSTYLE") 'словарь мультивыносок
 For Ind = 0 To objDict.count - 1
  Set objTMP = objDict.Item(Ind) 
  If objTMP.ObjectName = "AcDbMLeaderStyle" Then
   Set StLeader = objTMP
   If objTMP.Name = "Моя_мультивыноска" Then
    StLeaderAbsent = False
    Exit For
   End If
  End If
 Next Ind

А вот как этот стиль присвоить быстро созданной мультивыноске - не пойму.

Вот так создаю:

Код:

[Выделить все]

 Dim objLeader As AcadLeader
 Dim objEntForLeader As AcadEntity
 Dim NormalPoint(2) As Double
 Dim PointsLD(0 To 5) As Double

 PointsLD(0) = 0: PointsLD(1) = 0: PointsLD(2) = 0
 PointsLD(3) = 500: PointsLD(4) = 500: PointsLD(5) = 0
 NormalPoint(0) = 500
 NormalPoint(1) = 500
 NormalPoint(2) = 0
 'создаю многострочный текст
 Set objEntForLeader = ThisDrawing.ModelSpace.AddMText(NormalPoint, 1000, "Текст")
 'создаю мультиыноску
 Set objLeader = ThisDrawing.ModelSpace.AddLeader(PointsLD, objEntForLeader, acLineNoArrow)

И получаю на выходе сразу две беды.

1. Созданная мультивыноска в принципе не хочет принимать стиль путем банального копирования свойств методами автокад. Следовательно она изначально корявая получается
2. Как программно присвоить существующий стиль к программно (и даже не программно) созданной мультивыноске

Что-то внутри меня говорит, что не все просто. Надо отдельно мучать передачу свойств (стиля) многострочного текста и отдельно самой выноске. Ошибаюсь?

Wolkodaw · 22.10.2018, 19:03

Здравствуйте, может кто-нибудь помочь - не понимаю, как вставить стандартную мультивыноску AutoCAD?
Остановился вот на чём:

Код:

[Выделить все]

 
; Простановка мультивыносок для выбранных блоков
; Перед началом работы убедиться, что в настройках файла выбрана мультивыноска со стилем "1"

;;;;;;;;;;;;;;;;Подготовка;;;;;;;;;;;;;;;;
; загрузка корневых элементов функций ActiveX
(vl-load-com)
(setq acad_application (vlax-get-acad-object))
(setq active_document (vla-get-ActiveDocument acad_application))
(setq model_space (vla-get-ModelSpace active_document))
(setq paper_space (vla-get-PaperSpace active_document))

; создание переменных и списков, используемых в программе
(setq i -1)
(setq ars_blocks_list (list))

; Запрос масштаба у пользователя
(initget 7)
(setq scale (getint "Введите масштаб "))
(princ "Масштаб принят")


;;;;;;;;;;;;;;;;Извлечение из чертежа исходных блоков;;;;;;;;;;;;;;;;

; создание набора блоков с фильтром на блоки
(setq ars_blocks_set (ssget '((0 . "insert"))))

; оценка количества элементов в наборе
(setq ars_blocks_set_length (sslength ars_blocks_set))

; повтор функции (начало repeat)
(repeat ars_blocks_set_length (setq i (1+ i))

; преобразование блока во VLA-объект
(setq ars_blocks_vla (vlax-ename->vla-object (ssname ars_blocks_set i)))

; добавление преобразованного блока в список
(setq ars_blocks_list (cons ars_blocks_vla ars_blocks_list))

); конец repeat

;;;;;;;;;;;;;;;;Вставка мультивыносок;;;;;;;;;;;;;;;;

; вычисление длины списка
(setq ars_blocks_length (length ars_blocks_list))

; вставка мультивыноски
(setq ars_blocks_MV (vla-AddMLeader (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point 0 0 0) 0))

Заканчивается всё это выводом системного сообщения: "; ошибка: Ошибка Automation. Неверный список точек"

Что я делаю не так?

Сразу опишу поставленную цель (чтоб было понятнее): мультивыноска должна с блоков из созданного списка извлечь записанное ранее значение атрибута "ПОЗ" и записать его в мультивыноску. И так на все выделенные блоки. Предварительно вижу так, чтобы мультивыноски вставлялись в геометрическую середину блоков.

Кулик Алексей aka kpblc · 22.10.2018, 20:40

Все правильно. Читаем справку: нужно передавать массив точек (начало / конец - как минимум). Поставь вручную мультивыноску и сделай для нее дамп.

Vladimir_Sergeevich · 25.10.2018, 13:24

Цитата:

Сообщение от Wolkodaw

Заканчивается всё это выводом системного сообщения: "; ошибка: Ошибка Automation. Неверный список точек"

Что я делаю не так?

В случае Mleader одной точкой не отделаться, надо в один вариант сразу все точки передавать

Код:

[Выделить все]

 
;;pt_list - список из двух точек: начало и конец
(setq pt_variant 
	(vlax-make-variant
		(vlax-safearray-fill 
			(vlax-make-safearray 
				vlax-vbDouble 
				'(0 . 5) 
			) 
			(append (car pt_list) (cadr pt_list) 	)	
		) 	
	) 
)

yurms · 16.11.2018, 13:02

Упрямые ВЫноски!!
заходит свойство AML.TextDirection=5 -"по стилю".. и сменятся на 2=acRightToLeft не хочет? а на 3-без проблем
что за стиль мешает этому ? в стилях мультивыносок галочка снята

этот вопрос поднимался в посте #23 ☆ и ниже.. но понятного ответа я не узрел..

Код:

[Выделить все]

Set AML = acadDoc.ModelSpace.AddMLeader(points, xx) 'вставляем примитив в автокад и заполняем ниже его свойства

     If startPnt(0) <= endPnt(0) Then
                            AML.TextDirection = acLeftToRight ' с лева на право прекрасно работает
                            Else
'                            почему нельзя присвоить значение привязки выноски с правой стороны?
                           AML.TextDirection = acRightToLeft     ' с права на лева - вызывает ошибку
                           AML.TextDirection = acTopToBottom  'c верху в низ- прекрасно работает
                            End If

Кулик Алексей aka kpblc · 16.11.2018, 17:37

Вручную поменяй выравнивание и посмотри, какие свойства сменились.
ИМХО выравнивание текста (то бишь аннотации) здесь совсем не при делах. Могу ошибаться - давно с мультивыносками не работал...

posetitel · 05.02.2025, 11:49

Подниму тему.
Товарищи, подскажите, пожалуйста, как на VBA реализовать мультивыноску, чтобы текс в выноске сразу же отображался на экране, а вот конечное положение выноски можно было бы выбрать самому (например, в зависимости от длины текста). Для иллюстрации прилагаю гифку.
Требуемый функционал в примере реализован на лисп, но разобраться как именно и как это переложить на VBA никак не могу.

posetitel · 05.02.2025, 16:44

сам себе отвечу:
скорее всего стандартного метода нет, нужно писать отдельную функцию

Theodor · 05.02.2025, 21:07

Цитата:

Сообщение от posetitel

Товарищи, подскажите, пожалуйста, как на VBA реализовать мультивыноску, чтобы текс в выноске сразу же отображался на экране, а вот конечное положение выноски можно было бы выбрать самому (например, в зависимости от длины текста). Для иллюстрации прилагаю гифку.

Я, что-то, не понял задачи. Описание и гифка точно об одном и том же?

Сергей812 · 05.02.2025, 21:08

Цитата:

Сообщение от posetitel

скорее всего стандартного метода нет

чтобы было стандартным методом (точнее, стандартными средствами ЯП) - надо переходить на более "свежие" ЯП. Например, .Net

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Программное создание размерных стилей	Кулик Алексей aka kpblc	Программирование	96	21.02.2025 13:53
Программное создание 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