Topic: measure the width of the characters of a text and mtext

[amc.dicsac]

Hello, could someone tell me if there is a lisp that I can give the width measurement with the characters of a text and mtext.

[MP]

Use / Abuse:

Code: [Select]

(defun _GetBoundingBox ( object / result )
    (vl-catch-all-apply 'eval
       '(   (   (lambda ( object / a b )
                    (vlax-invoke-method object 'GetBoundingBox 'a 'b)
                    (setq result (mapcar 'vlax-safearray->list (list a b)))
                )
                (if (eq 'ename (type object))
                    (vlax-ename->vla-object object)
                    object
                )
            )
        )
    )
    result
)

[MP]

Noting that a text / mtext (or attribute) sporting an empty text string will return nil. This is thwartable by temporarily assigning a one space " " value. Useful if one is using said function to pull out the pseudo centroid for example. /Later.

[Lee Mac]

For TEXT, use the textbox function; for MTEXT, DXF group 42.

[amc.dicsac]

Well what I want to achieve is:

- Remove the length and width of the mtext text, then make the leader is the same length to text.

[amc.dicsac]

Someone who can help me please, where could not be the error.

Code - Auto/Visual Lisp: [Select]

1. (defun c:ale (/ c# crds doc e ins newpt obj ss txt x y sel)
2.   (vl-load-com)
3.   (setq doc (vla-get-activedocument (vlax-get-acad-object)))
4.   (setq e (car (entsel "\nSelect Text: ")))
5.      (progn (setq e (vla-copy (vlax-ename->vla-object e)))
6.             (setq lst nil )
7.          (repeat 1000
8.           (vla-GetBoundingBox e 'mi 'ma)
9.           (setq lst (cons (mapcar (function -) (vlax-safearray->list ma) (vlax-safearray->list mi))
10.                      lst
11.                ) ;_  cons
12.           ) ;_  setq
13.           (vla-rotate e (vlax-3d-point 0. 0.) (/ pi 1000.))
14.          ) ;_  repeat
15.          ;;;(vla-Delete e)
16.   ) ;_  progn
17.   (if (and lst (setq ss (ssget '((0 . "leader")))))
18.     (progn (vla-endundomark doc)
19.            (vla-startundomark doc)
20.            (foreach l (vl-remove e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
21.              (setq obj  (vlax-ename->vla-object l)
22.                    crds (vlax-get obj 'coordinates)
23.                    c#   (length crds)
24.              );_ setq
25.              (if (and (= c# 9) ;if leader has 3 points and /= x coord
26.                       (not (equal x (nth (- c# 3) crds) 0.0001))
27.                  );_ and
28.                (progn (setq y     (nth (- c# 5) crds) ;new y coord to ensure flat landing
29.                             newpt (list x y (nth (1- c#) crds))
30.                       );_ setq
31.                       (vlax-put obj
32.                                 'coordinates
33.                                 (append (reverse (cdddr (reverse crds))) newpt)
34.                       )
35.                       (vla-update obj)
36.                       (and (setq txt (vl-catch-all-apply ;has text attached to leader
37.                                        'vlax-ename->vla-object
38.                                        (list (cdr (assoc 340 (entget l))))))
39.                            (not (vl-catch-all-error-p txt)) ;check for invalid ename
40.                            (setq ins (vlax-get txt 'insertionpoint))
41.                            (vlax-put txt
42.                                      'insertionpoint
43.                                      (polar (list x (cadr ins) (caddr ins))
44.                                             (if (> x (nth (- c# 3) crds))
45.                                               0.
46.                                               pi
47.                                             )
48.                                             (if (zerop (getvar 'tilemode))
49.                                               (vla-get-textgap obj)
50.                                               (* (getvar 'dimscale) (vla-get-textgap obj)))))
51. (vla-update txt)))))
52. (vla-endundomark doc)))
53. (princ))
54.  

[PKENEWELL]

amc,

I really don't understand what you are trying to do with your code - some things really don't make sense to me in this, but - your error is coming up I think because you are specifying a variable "x" that was never set to something (see my comments in the below code snippets):

Someone who can help me please, where could not be the error.

Code - Auto/Visual Lisp: [Select]

1.                  ...
2.                  (if (and (= c# 9) ;if leader has 3 points and /= x coord
3.                       (not (equal x (nth (- c# 3) crds) 0.0001)) ;; PJK - WHERE  IS "X" Being Set?
4.                  );_ and
5.                  ...
6.                 (progn (setq y (nth (- c# 5) crds) ;new y coord to ensure flat landing
7.                                   newpt (list x y (nth (1- c#) crds)) ;; PJK - "X" will be NIL here
8.                            )
9.                           (vlax-put obj
10.                                         'coordinates
11.                                        (append (reverse (cdddr (reverse crds))) newpt) ;; You are Adding a Point list with NIL in it here!
12.                          )
13.                          ...
14.  

[PKENEWELL]

amc,

What is the purpose of this part of your code? Your rotating a copy of selected text around in a circle from 0,0,0 and making a list of coordinates - then your not using the variable "lst" for anything??? I'm sorry but your code is really not making any sense.

Code - Auto/Visual Lisp: [Select]

1.     (setq e (car (entsel "\nSelect Text: ")))
2.     (progn (setq e (vla-copy (vlax-ename->vla-object e)))
3.             (setq lst nil )
4.          (repeat 1000
5.           (vla-GetBoundingBox e 'mi 'ma)
6.           (setq lst (cons (mapcar (function -) (vlax-safearray->list ma) (vlax-safearray->list mi))
7.                      lst
8.                ) ;_  cons
9.           ) ;_  setq
10.           (vla-rotate e (vlax-3d-point 0. 0.) (/ pi 1000.))
11.          ) ;_  repeat
12.          ;;;(vla-Delete e)
13.   ) ;_  progn
14.  

[amc.dicsac]

Hello, this code is of this program. Alignment the leader

Code - Auto/Visual Lisp: [Select]

1. (defun c:ale (/ c# crds doc e ins newpt obj ss txt x y sel)
2.   (vl-load-com)
3.   (setq doc (vla-get-activedocument (vlax-get-acad-object)))
4.   (initget 0 "Leader PickPoint")
5.   (if (= (cond ((getkword
6.                   (strcat "\nAlinear a [Leader/PickPoint] <Leader>: ")
7.                 )
8.                )
9.                ("Leader")
10.          )
11.          "Leader"
12.       )
13.     (and (setq e (car (entsel "\nSelecciona el leader principal: ")))
14.          (setq x (cadr (assoc 10 (reverse (entget e)))))
15.     )
16.     (setq x (car (getpoint "\nSelecciona el punto base a alinear: ")))
17.   )
18.   (if (and x (setq ss (ssget '((0 . "leader")))))
19.     (progn (vla-endundomark doc)
20.            (vla-startundomark doc)
21.            (foreach l (vl-remove e
22.                                  (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
23.                       )
24.              (setq obj  (vlax-ename->vla-object l)
25.                    crds (vlax-get obj 'coordinates)
26.                    c#   (length crds)
27.              )
28.              (if (and (= c# 9) ;if leader has 3 points and /= x coord
29.                       (not (equal x (nth (- c# 3) crds) 0.0001))
30.                  )
31.                (progn (setq y     (nth (- c# 5) crds) ;new y coord to ensure flat landing
32.                             newpt (list x y (nth (1- c#) crds))
33.                       )
34.                       (vlax-put obj
35.                                 'coordinates
36.                                 (append (reverse (cdddr (reverse crds))) newpt)
37.                       )
38.                       (vla-update obj)
39.                       (and (setq txt (vl-catch-all-apply ;has text attached to leader
40.                                        'vlax-ename->vla-object
41.                                        (list (cdr (assoc 340 (entget l))))
42.                                      )
43.                            )
44.                            (not (vl-catch-all-error-p txt)) ;check for invalid ename
45.                            (setq ins (vlax-get txt 'insertionpoint))
46.                            (vlax-put txt
47.                                      'insertionpoint
48.                                      (polar (list x (cadr ins) (caddr ins))
49.                                             (if (> x (nth (- c# 3) crds))
50.                                               0.
51.                                               pi
52.                                             )
53.                                             (if (zerop (getvar 'tilemode))
54.                                               (vla-get-textgap obj)
55.                                               (* (getvar 'dimscale) (vla-get-textgap obj))
56.                                             )
57.                                      )
58.                            )
59.                            (vla-update txt)
60.                       )
61.                )
62.              )
63.            )
64.            (vla-endundomark doc)
65.     )
66.   )
67.   (princ)
68. )

[amc.dicsac]

I use this code to extract the width of text and mtext

Code - Auto/Visual Lisp: [Select]

1. (defun c:grua (/ E LST MA MI)
2.  (if (setq e (car (entsel "\n Select object: ")))
3.   (progn (setq e   (vla-copy (vlax-ename->vla-object e))
4.                lst nil
5.          ) ;_  setq
6.          (repeat 1000
7.           (vla-GetBoundingBox e 'mi 'ma)
8.           (setq
9.            lst (cons (mapcar (function -) (vlax-safearray->list ma) (vlax-safearray->list mi))
10.                      lst
11.                ) ;_  cons
12.           ) ;_  setq
13.           (vla-rotate e (vlax-3d-point 0. 0.) (/ pi 1000.))
14.          ) ;_  repeat
15.          (vla-Delete e)
16.    (princ "\n Bounding box object with minimal length: ")
17.    (princ (assoc (car (apply 'mapcar (cons 'min lst))) lst))
18.    (princ)
19.   ) ;_  progn
20.  ) ;_  if
21. ) ;_  defun

[PKENEWELL]

Based on your OP: Why not just use QLEADER to make your leaders?

Command: QLEADER
Specify first leader point, or [Settings] <Settings>: S
(see attached bitmap - set "underline bottom line")

Then - use Express Tools QLATTACH command

Command: _.qlattach
Select Leader:
Select Annotation:

[amc.dicsac]

It is a design theme that work separately.

[PKENEWELL]

It is a design theme that work separately.

OK - Are you trying to copy a text string to multiple leaders, then make the leader underlined?

[amc.dicsac]

not exactly:

1- I want to copy the text width length

[PKENEWELL]

I'm sorry but I cannot understand you enough to help you or figure out what you are trying to do in your code. Perhaps some else here can understand what you are trying to do better.

[amc.dicsac]

[T.Willey]

You can try this, but it does not work with mtext objects.  If it works for your dtext, then maybe you can change it to work with mtext.

It returns a list of two items.  You only need to worry about the first list, as that is the one that has the width per character.  You could use it like

(apply '+ (car (FontLetterWidth doc txObj)))

I do not have to time to play, but this is something I had already done.  Hope it is useful.

Code - Lisp: [Select]

1. (defun FontLetterWidth (Doc TextObj / MdSpc StyCol Sty FontName DictCol DictObj cnt CurLtr tempText ll ur Dist FontWidthList
2.                                       WidthList StyName String TextWd TextHt StyDictObj tempStrList tempList tempStr)
3.     ; Returns a list of distances for the text string of the object supplied.  The distances are that of each
4.     ;  letter in the string starting from the lower left bounding box point of the text, when the text is rotated
5.     ;  to 0.0 degrees.
6.     ; Idea from 'SomeCallMeDave' @ theswamp.  Thanks again.
7.  
8.     (setq StyName (vla-get-StyleName TextObj))
9.     (setq String (vlax-get TextObj (if (= (vla-get-ObjectName TextObj) "AcDbAttributeDefinition") "TagString" "TextString")))
10.     (setq TextWd (vla-get-ScaleFactor TextObj))
11.     (setq TextHt (vla-get-Height TextObj))
12.     (setq TextLen (strlen String))
13.     (setq cnt -1)
14.     (while (setq cnt (vl-string-search "%%" String (setq cnt (1+ cnt))))
15.         (setq tempStrList (cons (cons (1+ cnt) (setq tempStr (strcase (substr String (1+ cnt) 3)))) tempStrList))
16.     )
17.     (setq MdSpc (vla-get-ModelSpace Doc))
18.     (setq StyCol (vla-get-TextStyles Doc))
19.     (setq Sty (vla-Item StyCol StyName))
20.     (setq FontName
21.         (if (findfile (vla-get-fontFile Sty))
22.             (vl-filename-base (vla-get-fontFile Sty))
23.             (vl-filename-base (getvar "fontalt"))
24.         )
25.     )
26.     ;(setq DictCol (vla-get-Dictionaries Doc))
27.     ;(if (vl-catch-all-error-p (setq DictObj (vl-catch-all-apply 'vla-Item (list DictCol "MyFontWidthDict"))))
28.     ;   (setq DictObj (vla-Add DictCol "MyFontWidthDict"))
29.     ;)
30.     ;(if (vl-catch-all-error-p (setq StyDictObj (vl-catch-all-apply 'vla-Item (list DictObj StyName))))
31.     ;   (setq StyDictObj (vla-Add DictObj StyName))
32.     ;)
33.     (setq cnt 1)
34.     (while (<= cnt TextLen)
35.         (if (setq tempList (assoc cnt tempStrList))
36.             (progn
37.                 (setq CurLtr (cdr tempList))
38.                 (setq cnt (+ cnt 2))
39.             )
40.             (setq CurLtr (substr String cnt 1))
41.         )
42.         (if (not (assoc CurLtr FontWidthList))
43.             (progn
44.                 (cond
45.                     ((= CurLtr " ")
46.                         (setq tempText (vlax-invoke MdSpc 'AddText "AA" '(0.0 0.0 0.0) 1.0))
47.                         (vla-put-Height tempText 1.0)
48.                         (vla-put-ScaleFactor tempText 1.0)
49.                         (vlax-put tempText 'Normal '(0. 0. 1.))
50.                         (vla-put-StyleName tempText StyName)
51.                         (vla-GetBoundingBox tempText 'll 'ur)
52.                         (setq ll (safearray-value ll))
53.                         (setq ur (safearray-value ur))
54.                         (setq Dist (distance (cons (car ll) (cdr ur)) ur))
55.                         (vla-put-TextString tempText (strcat "A" CurLtr "A"))
56.                         (vla-GetBoundingBox tempText 'll 'ur)
57.                         (setq ll (safearray-value ll))
58.                         (setq ur (safearray-value ur))
59.                         (setq Dist (* TextWd (* TextHt (- (distance (cons (car ll) (cdr ur)) ur) Dist))))
60.                         (setq FontWidthList (cons (cons CurLtr Dist) FontWidthList))
61.                         (vla-Delete tempText)
62.                     )
63.                     ((and (equal cnt 3) (or (= CurLtr "%%U") (= CurLtr "%%O")))
64.                         (setq tempText (vlax-invoke MdSpc 'AddText "A" '(0.0 0.0 0.0) 1.0))
65.                         (vla-put-Height tempText 1.0)
66.                         (vla-put-ScaleFactor tempText 1.0)
67.                         (vlax-put tempText 'Normal '(0. 0. 1.))
68.                         (vla-put-StyleName tempText StyName)
69.                         (vla-GetBoundingBox tempText 'll 'ur)
70.                         (setq ll (safearray-value ll))
71.                         (setq ur (safearray-value ur))
72.                         (setq tempPt (cons (car ll) (cdr ur)))
73.                         (vla-put-TextString tempText (strcat CurLtr "A"))
74.                         (vla-GetBoundingBox tempText 'll 'ur)
75.                         (setq ll (safearray-value ll))
76.                         (setq ur (safearray-value ur))
77.                         (setq Dist (* TextWd (* TextHt (distance (cons (car ll) (cdr ur)) tempPt))))
78.                         (setq FontWidthList (cons (cons CurLtr Dist) FontWidthList))
79.                         (vla-Delete tempText)
80.                     )
81.                     (T
82.                         (setq tempText (vlax-invoke MdSpc 'AddText CurLtr '(0.0 0.0 0.0) 1.0))
83.                         (vla-put-Height tempText 1.0)
84.                         (vla-put-ScaleFactor tempText 1.0)
85.                         (vla-put-StyleName tempText StyName)
86.                         (vlax-put tempText 'Normal '(0. 0. 1.))
87.                         (vla-GetBoundingBox tempText 'll 'ur)
88.                         (setq ll (safearray-value ll))
89.                         (setq ur (safearray-value ur))
90.                         (setq Dist (distance (cons (car ll) (cdr ur)) ur))
91.                         (vla-put-TextString tempText (strcat CurLtr CurLtr))
92.                         (vla-GetBoundingBox tempText 'll 'ur)
93.                         (setq ll (safearray-value ll))
94.                         (setq ur (safearray-value ur))
95.                         (setq Dist (* TextWd (* TextHt (- (distance (cons (car ll) (cdr ur)) ur) Dist))))
96.                         (setq FontWidthList (cons (cons CurLtr Dist) FontWidthList))
97.                         (vla-Delete tempText)
98.                     )
99.                 )
100.             )
101.         )
102.         (if (and (not (equal cnt 3)) (or (= CurLtr "%%U") (= CurLtr "%%O")))
103.             (repeat 3
104.                 (setq WidthList (cons 0.0 WidthList))
105.             )
106.             (if (equal (strlen CurLtr) 3)
107.                 (repeat 3
108.                     (setq WidthList (cons (/ (cdr (assoc CurLtr FontWidthList)) 3.0) WidthList))
109.                 )
110.                 (setq WidthList (cons (cdr (assoc CurLtr FontWidthList)) WidthList))
111.             )
112.         )
113.         (setq cnt (1+ cnt))
114.     )
115.     ;(print FontWidthList)
116.     (list (reverse WidthList) tempStrList)
117. )
118.  

[cmwade77]

Based on your OP: Why not just use QLEADER to make your leaders?

Command: QLEADER
Specify first leader point, or [Settings] <Settings>: S
(see attached bitmap - set "underline bottom line")

Then - use Express Tools QLATTACH command

Command: _.qlattach
Select Leader:
Select Annotation:

Or you could use the mleader command with a custome style, we have similar leaders to this, but we don't do underlining, but it can do it.

[PKENEWELL]

Or you could use the mleader command with a custome style, we have similar leaders to this, but we don't do underlining, but it can do it.

Yes - that would work too. The reason I suggested QLEADER is because - out of the box - the Express Tool QLATTACH command works with Quick Leaders, but does not work with MLEADERS. I believe if the OP did a search for MTEXT to MLEADER however, there is probably some code already to do it with an MEADER:

Examples:
https://www.theswamp.org/index.php?topic=20228.msg245930#msg245930
https://www.theswamp.org/index.php?topic=43097.msg483158#msg483158
https://www.theswamp.org/index.php?topic=30319.msg359205#msg359205

[cmwade77]

Or you could use the mleader command with a custome style, we have similar leaders to this, but we don't do underlining, but it can do it.

Yes - that would work too. The reason I suggested QLEADER is because - out of the box - the Express Tool QLATTACH command works with Quick Leaders, but does not work with MLEADERS. I believe if the OP did a search for MTEXT to MLEADER however, there is probably some code already to do it with an MEADER:

Examples:
https://www.theswamp.org/index.php?topic=20228.msg245930#msg245930
https://www.theswamp.org/index.php?topic=43097.msg483158#msg483158
https://www.theswamp.org/index.php?topic=30319.msg359205#msg359205

Yep and there are many more, including routines to convert qLeaders to mleaders. Including my code at:
https://www.theswamp.org/index.php?topic=46576.msg515804#msg515804

It does a pretty decent job at it too, but the text does need to be mText to work properly.

[amc.dicsac]

I'm sorry but I cannot understand you enough to help you or figure out what you are trying to do in your code. Perhaps some else here can understand what you are trying to do better.

Hi, here I have the program, that have developed people in the acadhispano forum, please tell me if it is possible to do the same but with mtext.

Code - Auto/Visual Lisp: [Select]

1. ;;;;http://acadhispano.foroargentina.net/t34-ancho-mtext-y-text
2. (defun c:seltl ( / text lead lt lp pf i)
3. (if (and (setq text (entsel"\nSelect Text : "))
4.  (setq lead (entsel"\nSelect leader : ")) )
5.  (entmod
6.  (setq text (cdr(entget (car text)))
7.  lt (textbox text)
8.  lt (apply 'distance lt) ;; diagonal de la caja de texto
9.  lead (entget (car lead))
10.  lp (mapcar 'cdr (vl-remove-if '(lambda(a)(/=(car a) 10)) lead)) ;; puntos del leader
11.  pf (polar (cadr lp) (angle (cadr lp)(last lp)) lt) ;; nuevo punto final
12.  i 0 ;;; para solo cambiar el ϊltimo punto
13.  lead (mapcar '(lambda(a)(if (=(car a)10)(setq i(1+ i)))
14.  (if (and (= i 3)(=(car a)10))(cons 10 pf) a)) lead)
15.  ))
16.  (princ "\nEntidad no encontrada")
17. )
18. (princ)
19. )

Deputy dwg to run lisp

https://www.dropbox.com/sh/7kkt2zgdyjgbwwy/AAB1oH7LcnVVjjSGGz00ZYhLa?dl=0