单行文本动态神缩之（二）
本帖最后由 尘缘一生 于 2024-8-3 08:04 编辑此前哪，这个问题发过一贴：
http://bbs.mjtd.com/thread-190578-1-1.html
然而，还缺少一个“原位各自伸缩”的功能，如下所示：
完善，加一TAB键切换这个功能，代码如下：
;将角度修正到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"))))
)广而告之：画图的话，你想学技巧，和灵活性，哪你就应该看三领是怎么画图的。从而，你才能知道，你的还有很多你没有开发和支持。
老派高手 不错，就是只支持“text” 尺寸等别的类型还没放出来 本帖最后由 尘缘一生 于 2024-8-3 09:15 编辑
bai2000 发表于 2024-8-3 09:00
不错，就是只支持“text” 尺寸等别的类型还没放出来
这个有了，MTEXT的就好集成了，
三领有集成部分支持。
MTEXT本身代码不一样，也可以MTEXT->text->变换->MTEXT
[*];;框选TEXT,MTEXT..文字实体动态拉伸--------
[*](defun c:macedit ()
[*](princ (slmsg "请选择文字->" "叫匡拒ゅ->" "Please select text entitys->"))
[*](macedit-text (sstoslss (ssget ":S" '((0 . "ATTDEF,DIMENSION,TEXT,MTEXT,INSERT,TCH_ARROW,TCH_TEXT,TCH_DRAWINGNAME,TCH_MULTILEADER,TCH_ELEVATION,TCH_MTEXT,ATTRIB")))))
[*])
[*];;单行TEXT,MTEXT文本动态拉伸 ---(一级)----
[*](defun macedit0 (enam)
[*](if (= (dxf1 enam 0) "MTEXT")
[*] (macedit-mtext enam)
[*] (macedit-text (ssadd enam))
[*])
[*])
最近和文字有点过不去啊 利用分散对齐来伸缩文字，确实是个好办法。
页:
[1]