单行文本动态神缩
;将角度修正到0~2π之间-----(一级)-------(defun Angle-Mod (ang /)
(while (>= ang 2pi) (setq ang (- ang 2pi)))
(while (< ang 0) (setq ang (+ ang 2pi)))
ang
)
;角度转换至1,4象限----(一级)------
;(angle-sharp ang)
(defun angle-sharp (ang)
(setq ang (Angle-Mod ang))
(if (and (> ang pi2) (< ang pi)) (setq ang (+ ang pi)))
(if (and (>= ang pi) (<= ang 3pi2)) (setq ang (- ang pi)))
(if (equal ang 3pi2 0.01) (setq ang pi2))
(if (equal ang 2pi 0.01) (setq ang 0))
ang
)
;更新图元定义数据内容----(一级)------
;ent 为实体nam obj 或实体表 entget
(defun emod (ent i n / tp)
(setq tp (type ent))
(cond
((= tp 'VLA-OBJECT)
(setq ent (entget (obj2en ent) '("*")))
)
((= tp 'ENAME)
(setq ent (entget ent '("*")))
)
)
(if (= (assoc i ent) nil)
(entmod (append ent (list (cons i n))))
(subst (cons i n) (assoc i ent) ent)
)
)
;取得图元参数值内容-----(一级)-------
;(setq h (dxf1 ent 40))
;ent 为实体nam obj 或实体表 entget
(defun dxf1 (ent i / tmp tp)
(setq tp (type ent))
(cond
((= tp 'VLA-OBJECT)
(setq ent (entget (obj2en ent) '("*")))
)
((= tp 'ENAME)
(setq ent (entget ent '("*")))
)
)
(setq tmp (cdr (assoc i (vl-remove-if-not '(lambda (x) (= (car x) i)) ent))))
(if (null tmp)
(cond
((= i 66) 0)
((= i 48) (getvar "CELTSCALE"))
((member i '(6 62))
(cdr (assoc i (entget (tblobjname "LAYER" (cdr (assoc 8 ent)))))) ;对象所在图层颜色
)
((= i 370) -1)
((= i 7) $hz)
)
tmp
)
)
;计算cp到p1 p2的垂足点----(一级)------
(defun pertolinecz (cp p1 p2 / norm)
(setq norm (mapcar '- p2 p1)
p1 (trans p1 0 norm)
cp (trans cp 0 norm)
)
(trans (list (car p1) (cadr p1) (caddr cp)) norm 0)
)
;;返回 vla对象->ename对象名-------(一级)------
(defun obj2en (object)
(if (equal (type object) 'vla-object)
(setq object (vlax-vla-object->ename object))
object
)
object
)
;;^^^^^^^^^^^^^以上为三领集成的函数
;;单行TEXT文本选择集-动态拉伸---(一级)----
;;功能 程序去除文字的前面空格,后面的空格,进行整体(各自单独)动态伸缩,保持角度,定位点不变
;三领设计 V3.0 Modify by 尘缘一生QQ:15290049 2024.8.3 (精简后代码)
(defun macedit-text (ss / ms1 ms2 ms3 pt bb loop p0 kk)
(defun sskk (ss pt kk / enam ent p tx ang i n m)
(setq n (sslength ss) m 0)
(while (< m n)
(setq enam (ssname ss m))
(setq ent (entget enam) p (dxf1 ent 10) tx (dxf1 ent 1) ang (angle-sharp (dxf1 enam 50)))
(while (= (substr tx 1 1) " ")
(setq tx (substr tx 2))
)
(setq i (strlen tx))
(while (= (substr tx i 1) " ")
(setq tx (substr tx 1 (1- i)) i(strlen tx))
)
(if kk
(entmod (emod (emod (emod (emod ent 1 tx) 11 (pertolinecz pt p (polar p ang 300.0))) 72 5) 73 0)) ;变F(双穴点)定位,去前后空格,确保右侧对齐光标点
(entmod (emod (emod (emod (emod ent 1 tx) 11 (polar p ang (* 0.2 (distance pt p0)))) 72 5) 73 0))
)
;(if (if-color) (vla-put-color (en2obj enam) (atoi (slsjqs))))
(setq m (1+ m))
)
)
;;-------------
(setq ms1 "\n 文本动态伸缩>>>[对齐方式切换(TAB)](左、右键>退出)"
ms2 "当前<整体对齐伸缩>:"
ms3 "当前<各自伸缩>:"
)
(princ (strcat ms1 ms2))
(setq loop t kk t p0 (cadr (grread 5)))
(while loop
(setq bb (grread t 15 2) pt (cadr bb))
(cond
((member bb '((2 9)));;table 键
(if (= kk t)
(progn (setq kk nil) (princ (strcat ms1 ms3)))
(progn (setq kk t) (princ (strcat ms1 ms2)))
)
)
((= (car bb) 5)
(sskk ss pt kk)
)
((member (car bb) '(3 11 25));;左键 右键 定位退出
(setq loop nil)
)
)
)
;(while (setq enam (ssname ss 0)) ;等同于(vl-cmdf "_.JustifyText" ss "" "L")
;(text:alignmod enam "L")
;(ssdel enam ss)
;)
(princ)
)
;;测试:框选TEXT,文字实体动态拉伸
(defun c:tt ()
(princ "请选择文字->")
(macedit-text (ssget ":S" '((0 . "TEXT"))))
)
页:
[1]