DText alignment routine

[Fantomas]

This program for automatic alignment of DText. You can choose Standard or Custom distance between strings. Alignment is made on the upper string. All types of alignment behind exception Alignment and Fit are supported. For AutoCAD 2000+.


(defun c:dali (/ tHeight insPoint dtSet oldDisMode errFlag
sStr tAlignPt tAlignment disDelta dtList
oldStrDis)

(defun texAlign (item /)
(setq disDelta(- disDelta dali:strDis)); end setq
(vla-put-Alignment (car str) tAlignment)
(cond
((= tAlignment 0)
(vla-put-InsertionPoint (car str)
(vlax-3D-Point(car insPoint)
(+ disDelta(cadr insPoint))(nth 2 insPoint)))
)
((member tAlignment '(1 2 4 6 7 8 9 10 11 12 13 14))
(vla-put-TextAlignmentPoint (car str)
(vlax-3D-Point(car tAlignPt)
(+ disDelta(cadr tAlignPt))(nth 2 tAlignPt)))
)
((member tAlignment '(3 5))
(princ "\nCan't align string with Aligned or Fit alignment ")
)
); end cond
); end of texAlign

(if(not dali:disMode)(setq dali:disMode "S"))
(setq oldDisMode dali:disMode)
(if(not dali:strDis)(setq dali:strDis 4.167))
(setq oldStrDis dali:strDis)
(initget "S C")
(setq dali:disMode
(getkword
&#40;strcat "\nSpecify distance between strings &#91;Standard/Custom&#93; <" dali&#58;disMode ">&#58; "&#41;&#41;&#41;
&#40;if&#40;null dali&#58;disMode&#41;&#40;setq dali&#58;disMode oldDisMode&#41;&#41;
&#40;if&#40;= dali&#58;disMode "C"&#41;
&#40;progn
&#40;setq dali&#58;strDis&#40;getdist&#40;strcat "\nSpecify Custom distance <"&#40;rtos dali&#58;strDis&#41; ">&#58; "&#41;&#41;&#41;
&#40;if&#40;null dali&#58;strDis&#41;&#40;setq dali&#58;strDis oldStrDis&#41;&#41;
&#40;princ&#40;strcat "\nCustom distance is "&#40;rtos dali&#58;strDis&#41;&#41;&#41;
&#41;; end progn
&#41;; end if
&#40;princ "\n*** Select DText and press Enter *** "&#41;
&#40;if
&#40;setq dtSet&#40;ssget '&#40;&#40;0 . "TEXT"&#41;&#41;&#41;&#41;
&#40;progn
&#40;setq dtList&#40;vl-sort&#40;mapcar
'&#40;lambda &#40;x&#41;&#40;list x
&#40;+&#40;cadr&#40;vlax-safearray->list
&#40;vlax-variant-value
&#40;vla-get-InsertionPoint x&#41;&#41;&#41;&#41;
&#40;cadr&#40;vlax-safearray->list
&#40;vlax-variant-value
&#40;vla-get-TextAlignmentPoint x&#41;&#41;&#41;&#41;&#41;&#41;&#41;
&#40;mapcar 'vlax-ename->vla-object
&#40;vl-remove-if 'listp
&#40;mapcar 'cadr&#40;ssnamex dtSet&#41;&#41;&#41;&#41;&#41;
&#40;function&#40;lambda&#40;a b&#41;&#40;>&#40;cadr a&#41;&#40;cadr b&#41;&#41;&#41;&#41;&#41;
tHeight&#40;vla-get-Height &#40;caar dtList&#41;&#41;
insPoint&#40;vlax-safearray->list
&#40;vlax-variant-value
&#40;vla-get-InsertionPoint &#40;caar dtList&#41;&#41;&#41;&#41;
tAlignPt&#40;vlax-safearray->list
&#40;vlax-variant-value
&#40;vla-get-TextAlignmentPoint &#40;caar dtList&#41;&#41;&#41;&#41;
tAlignment&#40;vla-get-Alignment &#40;caar dtList&#41;&#41;
dtList&#40;cdr dtList&#41;
disDelta 0.0
&#41;; end setq
&#40;if&#40;= dali&#58;disMode "S"&#41;&#40;setq dali&#58;strDis&#40;* 1.6668 tHeight&#41;&#41;&#41;
&#40;foreach str dtList
&#40;if
&#40;not
&#40;vl-catch-all-error-p
&#40;vl-catch-all-apply 'texAlign &#40;list str&#41;&#41;&#41;&#41;
&#40;princ&#41;
&#40;setq errFlag T&#41;
&#41;; end if
&#41;; end foreach
&#40;if errFlag&#40;princ "\n*** Some objects on Locked Layer ***"&#41;&#41;
&#41;; end progn
&#40;princ "\nString isn't selected. "&#41;
&#41;; end if
&#40;princ&#41;
&#41;; end of dali
&#40;vl-load-com&#41;

[JimWebster]

What a useful routine! Thanks!! :D :D