单行文本动态神缩之（二）

尘缘一生 · 发表于 2024-8-3 08:02:08

本帖最后由尘缘一生于 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"))))
)

;将角度修正到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")))) 
)

广而告之：画图的话，你想学技巧，和灵活性，哪你就应该看三领是怎么画图的。从而，你才能知道，你的还有很多你没有开发和支持。

MZ_li · 发表于 2024-8-3 08:21:24

老派高手

bai2000 · 发表于 2024-8-3 09:00:44

不错，就是只支持“text” 尺寸等别的类型还没放出来

尘缘一生 · 发表于 2024-8-3 09:13:55

本帖最后由尘缘一生于 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))
)
)

muai2010 · 发表于 2024-8-3 09:46:33

最近和文字有点过不去啊

hubeiwdlue · 发表于 2024-8-3 17:46:30

利用分散对齐来伸缩文字，确实是个好办法。

账号		自动登录	找回密码
密码			注册

单行文本动态神缩之（二）

本帖子中包含更多资源