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

[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