Topic: Workaround for buggy ArrowSymbol property

[Jürg Menzi]

Hi all

I'm struggling around with a programmatic control of MLEADERSTYLES.
One point in my function, setting the ArrowSymbol property, is exasperating.
I know there is a bug in the Vlisp API for donkey's years, but I'm searching a way for a workaround.
As we know, vla-get-ArrowSymbol returns an empty string "" in case of 'Closed filled' symbol.
Using vla-put-ArrowSymbol with a "" or "." argument returns an 'Automation Error. Key not found'.
It seems that I have no possibility to set the ArrowSymbol on this way.

Then I've checked the entity list of the MLeaderStyle object and found a 341 reference to the arrow block entity.
In case of 'Closed filled', the 341 code contains an <Entity name: 0>.

To cut a long story short:
Is there a way to create an <Entity name: 0>?
Because this steps are working:
- Command MleaderStyle to choose arrow symbol 'Closed filled'
- Then get the 341 data from the entity list into a variable (cdr (assoc...
- Command MleaderStyle to choose another arrow symbol
- Modify the entity list back by variable (subst..., entmod...)
- Ta-dah!, the 'Closed filled' symbol will be set

Thank you
Cheers

[fixo]

Try something like

Code: [Select]

(setq oldblk (getvar "dimldrblk"))
  (setvar "dimldrblk" ".")
  ;;create style afterGlad to see you again
Kind regards,
Oleg

[Jürg Menzi]

Hi Oleg

Try something like

Code: [Select]

(setq oldblk (getvar "dimldrblk"))
  (setvar "dimldrblk" ".")
  ;;create style afterGlad to see you again
Kind regards,
Oleg

DIMLDRBLK has no influence in MLeaderStyles, works only with Leader or Qleader in DimStyles.

Thank you anyway
Cheers

[CAB]

Is there a way to create an <Entity name: 0>?

Select a detached leader:
(setq ent (cdr(assoc 340 (entget(car(entsel))))))

[ronjonp]

Boy .... this really is a PITA.

[Jürg Menzi]

Hi CAB

Select a detached leader:
(setq ent (cdr(assoc 340 (entget(car(entsel))))))

Thank you
Cheers

You gave me the Idea to solve the problem, works lika a charm now:

Code: [Select]

;
; == Function MePutArrowSymbol
; Replaces the buggy 'vla-put-ArrowSymbol' property.
; Arguments [Type]:
;   Obj = MLeaderstyle object [VLA-OBJECT]
;   Asn = Arrow symbol name [STR]
;         Allowed names = Displayed names:
;         "_ARCHTICK" = Architectural tick
;         "_BOXBLANK" = Box
;         "_BOXFILLED" = Box filled
;         "_CLOSED" = Closed
;         "_CLOSEDBLANK"= Closed blank
;         "" = Closed filled
;         "_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
; Return [Type]:
;   > nil [BOOLEAN]
; Notes:
;   - None
;
(defun MePutArrowSymbol (Obj Asn / TmpVar)
 (if (eq Asn "")
  (entmod
   (MeSubst
    341
    (MeGetNullEntity)
    (entget (vlax-vla-object->ename Obj))
   )
  )
  (progn
   (setq TmpVar (getvar "DIMBLK"))
   (setvar "DIMBLK" Asn)
   (vla-put-ArrowSymbol Obj Asn)
   (setvar "DIMBLK" (if (eq TmpVar "") "." TmpVar))
  )
 )
 nil
)
;
; == Function MeGetNullEntity
; Returns a 'Null' entity.
; Arguments [Type]:
;   --- =
; Return [Type]:
;   > 'Null' entity [ENAME]
; Notes:
;   - Requres the global AcadDocument object Me:AcD
;   - Credits to CAB@The Swamp
;
(defun MeGetNullEntity ( / TmpObj NulEnt)
 (setq TmpObj (vlax-invoke
               (MeGetCurSpace Me:AcD)
              'AddMLeader
              '(0.0 0.0 0.0 1.0 1.0 0.0)
               1
              )
       NulEnt (car
               (vl-remove-if
               '(lambda (l) (entget l))
                (MeGetMassoc
                 340
                 (entget (vlax-vla-object->ename TmpObj))
                )
               )
              )
 )
 (vla-Delete TmpObj)
 NulEnt
)
;
; == Function MeGetCurSpace
; Returns the current space object.
; Arguments [Type]:
;   Acd = Active document object [VLA-OBJECT]
; Return [Type]:
;   > Mspace or Pspace object [VLA-OBJECT]
; Notes:
;   - None
;
(defun MeGetCurSpace (Acd)
 (if (or (= (getvar "TILEMODE") 1) (> (getvar "CVPORT") 1))
  (vla-get-ModelSpace Acd)
  (vla-get-PaperSpace Acd)
 )
)
;
; == Function MeGetMassoc
; Get multiple associative values from a list.
; Arguments [Type]:
;   Key = Assoc key to search [INT]
;   Lst = Dotted pair list [LIST]
; Return [Type]:
;   > List of values [LIST]
; Notes:
;   - Credits to Michael Puckett
;
(defun MeGetMassoc (Key Lst / RetVal TmpLst TmpVal)
 (setq TmpLst Lst)
 (reverse
  (progn
   (while (setq TmpVal (assoc Key TmpLst))
    (setq RetVal (cons (cdr TmpVal) RetVal)
          TmpLst (cdr (member TmpVal TmpLst))
    )
   )
   RetVal
  )
 )
)
;
; == Function MeSubst
; Substitutes a dotted pair list value.
; Arguments [Type]:
;   Key = Assoc key [ALL]
;   Val = Assoc value [ALL]
;   Lst = Dotted pair list [LIST]
; Return [Type]:
;   > Modified list [LIST]
; Notes:
;   - None
;
(defun MeSubst (Key Val Lst)
 (subst (cons Key Val) (assoc Key Lst) Lst)
)


[fixo]

Looks like an oldie but goody "Menzi's formatting style",
Thanks for the sharing,
Kind regards,

[Jürg Menzi]

Hi Oleg

You're welcome
Cheers

Looks like an oldie but goody "Menzi's formatting style",
Thanks for the sharing,
Kind regards,

[VVA]

See examples in the functions below

Code: [Select]

;;; How to set new MLeaderStyle properties 
;;; http://www.theswamp.org/index.php?topic=40944.0
(defun mip-mleader-style-create-dxf (mleaderstylename dimblk)
;;;mleaderstylename - string mleader style name
;;;dimblk - Arrow Symbol block name (or "" - none)
;;;;         "_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
;;;Use
;;; (mip-mleader-style-create-dxf "test-DOT" "_Dot")
;;; (mip-mleader-style-create-dxf "test-Open30" "_Open30")
  (vl-catch-all-apply
    '(lambda (/ tb tb-dic xr)
       ;;Add mleader style
       (if
         (and
           (getvar "CMLEADERSTYLE") ;_AutoCAD supports multileader
           (setq tb-dic (dictsearch (namedobjdict) "ACAD_MLEADERSTYLE")) ;_Exists dictionary Multileaders
           (not (member (cons 3 mleaderstylename)
                        (dictsearch (namedobjdict) "ACAD_MLEADERSTYLE")
                ) ;_ end of member
           ) ;_ end of not
         )                                        ; No style multileader
          (progn
            (if (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 (= tb "")
                          "."
                          tb
                        ) ;_ end of if
                ) ;_ end of setvar
              ) ;_ end of progn
            ) ;_ end of if
            (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")
                     (cons
                       341
                       (cdr (assoc 330 (entget (tblobjname "BLOCK" dimblk)))
                       ) ;_ end of CDR
                     )                            ;Leader ArrowID           
                     '(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" "Standard")) ;_Style

                   ) ;_ end of list
            ) ;_ end of setq
            (if (setq xr (entmakex tb))
              (dictadd (cdr (assoc -1 tb-dic)) mleaderstylename xr)
            ) ;_ end of if
          ) ;_ end of progn
       ) ;_ end of if
     ) ;_ end of lambda
  ) ;_ end of VL-CATCH-ALL-APPLY
  mleaderstylename
) ;_ end of defun

(defun mip-mleader-style-create (mleaderstylename
                                 dimblk         /
                                 mldrdict       newldrstyle
                                 textcolor      leadercolor
                                 objcolor
                                )
;;;   mleaderstylename - style name
;;;   dimblk - Arrow Symbol block name or nil - none
;;; 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
;;; Use
;;;  (mip-mleader-style-create "Test-O90" "_OPEN90")

  (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) ;_Arrow Size
                      (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" "Continuous") ;_ "ByBlock"
                      '("LeaderLineWeight" 30) ;_Line Weight
                      '("MaxLeaderSegmentsPoints" 2)
                      '("ScaleFactor" 1.0)
                      '("SecondSegmentAngleConstraint" 0)
                      '("TextAlignmentType" 0)
                      '("TextAngleType" 0)
                      '("TextHeight" 1.5) ;_Text size
                      '("TextLeftAttachmentType" 3)
                      '("TextRightAttachmentType" 3)
                      '("TextString" "")
                      '("TextStyle" "Standard") ;_Text style
                    ) ;_ end of list
        (vlax-put-property newldrstyle (car item) (cadr item))
      ) ;_ end of foreach
      newldrstyle
    ) ;_ end of progn
  ) ;_ end of if
) ;_ end of defun


[Jürg Menzi]

Hi VVA

Thank you for showing the code, but both functions are not able to set a 'Closed filled' arrow symbol.

Cheers

See examples in the functions below

Code: [Select]

;;; How to set new MLeaderStyle properties 
;;; http://www.theswamp.org/index.php?topic=40944.0
(defun mip-mleader-style-create-dxf (mleaderstylename dimblk)
...
) ;_ end of defun

(defun mip-mleader-style-create (mleaderstylename
                                 dimblk         /
                                 mldrdict       newldrstyle
                                 textcolor      leadercolor
                                 objcolor
                                )
...
) ;_ end of defun


[silvy]

You can get the type of arrow a Multileader applying four times the function <entget>.
It matches to a line, a polyline, a circle, an arc or a solid depending on the type of the arrow.
code:
(setq lst-ent (entget (car (entsel))))
(setq ed3 (entget (cdr (assoc 342 lst-ent))))
(setq ed33 (entget (cdr (assoc 360 ed3))))
(setq ed34 (entget (cdr (assoc -2 ed33))))

For an arrow "Integral"
Example
((-1 . <Entity name: 7f6f5b08100>) (0 . "MULTILEADER")(....
((-1 . <Entity name: 7f6f5b21b20>) (0 . "BLOCK_RECORD")(.....
((-1 . <Entity name: 7f6f5b21b50>) (0 . "BLOCK")(.....
((-1 . <Entity name: 7f6f5b21b30>) (0 . "SOLID")(.....

[Jürg Menzi]

Hi Silvy

An Mleader object with an arrow symbol 'Closed filled' has no 342 code in the entity list. In case of other arrow symbols 342 is present.

Cheers
Jürg

You can get the type of arrow a Multileader applying four times the function <entget>.
It matches to a line, a polyline, a circle, an arc or a solid depending on the type of the arrow.
code:
(setq lst-ent (entget (car (entsel))))
(setq ed3 (entget (cdr (assoc 342 lst-ent))))
(setq ed33 (entget (cdr (assoc 360 ed3))))
(setq ed34 (entget (cdr (assoc -2 ed33))))

For an arrow "Integral"
Example
((-1 . <Entity name: 7f6f5b08100>) (0 . "MULTILEADER")(....
((-1 . <Entity name: 7f6f5b21b20>) (0 . "BLOCK_RECORD")(.....
((-1 . <Entity name: 7f6f5b21b50>) (0 . "BLOCK")(.....
((-1 . <Entity name: 7f6f5b21b30>) (0 . "SOLID")(.....

[silvy]

Hi,
Examining closely the "DXF Group Code" generated by: (setq lst-ent (entget (car (entsel)))), I
realized too that the DXF Group Code 342 missing, but only when using the arrow "Closed Filled"(arrow default)

Below two examples:
the first uses an arrow "Closed" with ArrowSide = 4

(setq lst-ent (entget (car (entsel))))
(setq ed3 (entget (cdr (assoc 342 lst-ent))))
 
((-1 . <Entity name: 7f6f4f0a690>) (0 . "MULTILEADER") (330 . <Entity name: 7f6f4f069f0>) (5 . "551") (100 . "AcDbEntity") (67 . 0)... (omissis)...
(341 . <Entity name: 7f6f4f06940>) (171 . -2) (290 . 1) (291 . 1) (41 . 70.0)
(342 . <Entity name: 7f6f4f0a2a0>) (42 . 64.0) (172 . 2)
(343 . <Entity name: 7f6f4f06910>) (173 . 1) (95 . 1) (174 . 1) (175 . 0) (92 . -1056964608) (292 .
0) (93 . -1056964608) (10 1.0 1.0 1.0) (43 . 0.0) (176 . 0) (293 . 0) (294 . 0) (178 . 0) (179 . 1)
(45 . 1.0) (271 . 0) (272 . 9) (273 . 9) (295 . 0))

((-1 . <Entity name: 7f6f4f0a2a0>) (0 . "BLOCK_RECORD") (330 . <Entity name: 7f6f4f06810>) (5 .
"4CA") (100 . "AcDbSymbolTableRecord") (100 . "AcDbBlockTableRecord") (2 . "_Closed") (360 . <Entity
name: 7f6f4f0a2f0>) (340 . <Entity name: 0>) (70 . 0) (280 . 1) (281 . 0))

The second example uses an arrow "Closed Filled" (arrow default) with Arrowsize = 4

((-1 . <Entity name: 7f6f4f0a6a0>) (0 . "MULTILEADER") (330 . <Entity name: 7f6f4f069f0>) (5 . "552")
(100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "Layer6")... (omissis)... (340 . <Entity name:
7f6f4f09160>) (90 . 1074153442) (170 . 1) (91 . -1073741824)
(341 . <Entity name: 7f6f4f06940>) (171 . -2) (290 . 1) (291 . 1) (41 . 70.0) (42 . 64.0) (172 . 2)

(343 . <Entity name: 7f6f4f06910>) (173 . 1) (95 . 1) (174 . 1) (175 . 0) (92 . -1056964608) (292 .
0) (93 . -1056964608) (10 1.0 1.0 1.0) (43 . 0.0) (176 . 0) (293 . 0) (294 . 0) (178 . 0) (179 . 1)
(45 . 1.0) (271 . 0) (272 . 9) (273 . 9) (295 . 0))
nil (the last line is not processed).
In this example, the Group Code 341 includes, in the end, the two dotted-pair who were part of the Group Code 342 in the previous example.
---
See also ArrowHeadType property in ActiveX.

Happy Easter

 

[Jürg Menzi]

Hi Silvy

That's what I meant, but if you've read my introducing post you can see that I wasn't looking for the MLeader object, but rather the MLeaderStyle object. The ArrowSymbol property (not ArrowheadType) of this object has no acArrowXXX enums, but rather string values like used in the DIMBLK variable.
The (solved) problem was that the ArrowSymbol property does not accept a "" or "." value to set the 'Closed filled' arrow.

Cheers

Hi,
Examining closely the "DXF Group Code" generated by: (setq lst-ent (entget (car (entsel)))), I
realized too that the DXF Group Code 342 missing, but only when using the arrow "Closed Filled"(arrow default)
...

---
See also ArrowHeadType property in ActiveX.

Happy Easter