尘缘一生 发表于 2022-11-28 22:35:31

文字动态伸缩(GIF展示)

本帖最后由 尘缘一生 于 2022-11-29 06:57 编辑

此为开发的中间产品。
还是采取先炸开MTEXT,处理集伸缩,最后在合并成MTEXT,这不怎么好的方式。
对于文字动态伸缩,同时变动字高的功能消除不用,因为,那种情况你几乎不需要的。




由于大动画发不上,动画只展示水平的,对倾斜的,垂直90度的,均支持。
用到一个重要的,信源码,合并TEXT到MTEXT函数,经过改写,支持垂直90度文字,贴在下面。


[*];单行文字选择集转多行文字----(一级)------
[*]; 缘自信工具源码 MODIFY 尘缘一生 2022-11-29
[*];ssText文字选择集 fSpace 行距比例
[*](defun sl-ss-txt2mtext (ssText fSpace / e_lst ptLeftTop fRecWidth Mats x y lstText eText edata fHeight fWidth ang
[*]                         lst1 lstText1 e e1 e2 box lstReplace ename)
[*](setq e_lst (sysvar '("TEXTSTYLE" "CLAYER")))
[*](setq lstText (ss-enlst ssText))
[*](setq ename (ssname ssText 0))
[*](setq ang (dxf1 ename 50))
[*](command "UCS" "OB" ename)
[*](setq lstText
[*]    (mapcar
[*]      '(lambda (eText / edata pt)
[*]         (setq edata (entget eText))
[*]         (setq pt (dxf1 edata 10))
[*]         (trans pt 0 1)
[*]         (list pt edata)
[*]       )
[*]      lstText
[*]    )
[*])
[*](if (/= 1 (sin ang)) ;非垂直
[*]    (progn
[*]      (setq lstText (vl-sort lstText '(lambda (e1 e2) (> (cadar e1) (cadar e2)))))
[*]      (setq y (cadaar lstText))
[*]      (foreach eText lstText
[*]      (setq fHeight (dxf1 (cadr eText) 40))
[*]      (if (< (abs (- y (cadar eText))) fHeight) ;同行
[*]          (progn
[*]            (setq lst1 (cons eText lst1))
[*]            (setq y (cadar eText))
[*]          )
[*]          (progn
[*]            (setq lstText1 (cons lst1 lstText1)) ;加入
[*]            (setq y (cadar eText))
[*]            (setq lst1 (list eText))
[*]          )
[*]      )
[*]      )
[*]    )
[*]    (progn ;垂直
[*]      (setq lstText (vl-sort lstText '(lambda (e1 e2) (< (caar e1) (caar e2)))))
[*]      (setq x (caaar lstText))
[*]      (foreach eText lstText
[*]      (setq fHeight (dxf1 (cadr eText) 40))
[*]      (if (< (abs (- x (caar eText))) fHeight) ;同行
[*]          (progn
[*]            (setq lst1 (cons eText lst1))
[*]            (setq x (caar eText))
[*]          )
[*]          (progn
[*]            (setq lstText1 (cons lst1 lstText1)) ;加入
[*]            (setq x (caar eText))
[*]            (setq lst1 (list eText))
[*]          )
[*]      )
[*]      )
[*]    )
[*])
[*](if lst1 (setq lstText1 (cons lst1 lstText1)))
[*](setq lstText
[*]    (mapcar
[*]      '(lambda (lst1)
[*]         (mapcar 'cadr
[*]         (vl-sort lst1
[*]             (if (/= 1 (sin ang))
[*]               '(lambda (e1 e2)
[*]                  (< (caar e1) (caar e2))
[*]                )
[*]               '(lambda (e1 e2)
[*]                  (< (cadar e1) (cadar e2))
[*]                )
[*]             )
[*]         )
[*]         )
[*]       )
[*]      lstText1
[*]    )
[*])
[*](setq lstText (reverse lstText))
[*](setq fRecWidth
[*]    (apply
[*]      'max
[*]      (mapcar
[*]      '(lambda (e)
[*]         (if (> (length e) 1)
[*]             (apply
[*]               '+
[*]               (mapcar
[*]               '(lambda (e1 / box)
[*]                  (setq box (textbox e1))
[*]                  (caadr box)
[*]                  )
[*]               e
[*]               )
[*]             )
[*]             (caadr (textbox (car e)))
[*]         )
[*]         )
[*]      lstText
[*]      )
[*]    )
[*])
[*](setq fRecWidth (* fRecWidth 1.2) lst1 (caar lstText))
[*](setq fHeight (dxf1 lst1 40))
[*](setq ptLeftTop (dxf1 lst1 10))
[*](setq ang (dxf1 lst1 50))
[*](setq box (textbox lst1))
[*](setq ptLeftTop
[*]    (polar ptLeftTop ang
[*]      (apply 'min
[*]      (setq a
[*]          (vl-remove nil
[*]            (mapcar
[*]            '(lambda (lst / str)
[*]               (setq str (dxf1 lst 1))
[*]               (cond
[*]                   ((wcmatch str " *, *") 0)
[*]                   ((> (ascii (substr str 1 1)) 128)
[*]                     0
[*]                   )
[*]                   (T
[*]                     (caar (textbox lst))
[*]                   )
[*]               )
[*]               )
[*]            (mapcar 'car lstText)
[*]            )
[*]          )
[*]      )
[*]      )
[*]    )
[*])
[*](setq ptLeftTop (polar ptLeftTop (+ ang pi2) (apply 'max (mapcar '(lambda (e) (dxf1 e 40)) (car lstText)))))
[*](sl:-erase ssText)
[*](setvar 'clayer (dxf1 lst1 8))
[*](setvar 'TEXTSTYLE (dxf1 lst1 7))
[*](setq fWidth (dxf1 (tblsearch "Style" (getvar 'textstyle)) 41))
[*](setq sText
[*]    (mapcar
[*]      '(lambda (e)
[*]         (apply
[*]         'strcat
[*]         (mapcar
[*]             '(lambda
[*]                (e1 / str h w c pre)
[*]                (setq str (dxf1 e1 1))
[*]                (setq h (dxf1 e1 40))
[*]                (setq w (dxf1 e1 41))
[*]                (setq c (dxf1 e1 62))
[*]                (setq str (t-string-subst"\\{" "{" str))
[*]                (setq str (t-string-subst"\\}" "}" str))
[*]                (setq pre "")
[*]                (if (not (equal h fHeight)) (setq pre (strcat pre "\\H" (rtos (/ h fHeight) 2 1) "x;")))
[*]                (if (not (equal w fWidth)) (setq pre (strcat pre "\\W" (rtos w 2 1) ";")))
[*]                (if c (setq pre (strcat pre "\\C" (rtos c 2 0) ";")))
[*]                (if (/= pre "")
[*]                  (setq str (strcat "{" pre str "}"))
[*]                  str
[*]                )
[*]            )
[*]             e
[*]         )
[*]         )
[*]       )
[*]      lstText
[*]    )
[*])
[*](setq sText (sl:List->String sText "\\P"))
[*](command "UCS" "P")
[*](Make-MText sText ptLeftTop fRecWidth fHeight fSpace ang 1 1)
[*](mapcar 'eval e_lst)
[*])



mokson 发表于 2023-3-24 08:14:25

最后出现了两个笑脸,是什么字母?

guosheyang 发表于 2023-3-26 19:39:37

模仿下大佬的功能   用的是修改文字样式方法

戏男 发表于 2023-6-8 11:12:19

最后出现了两个笑脸,是什么字母?

magicheno 发表于 2022-11-29 00:46:19

大佬,给力~~~

中国梦 发表于 2022-11-29 05:30:27


感谢楼主分享!!!

hoodpinrh 发表于 2022-11-29 07:54:43

感謝樓主分享
學習一下

行天下 发表于 2022-11-29 08:13:58



感谢楼主分享!!!

cghdy 发表于 2022-11-29 09:11:15

лл

czb203 发表于 2022-11-29 09:38:49

感謝樓主分享
學習一下

624617205 发表于 2022-11-29 16:01:06

大佬,给力~~~

w379106181 发表于 2022-12-1 08:02:43




感谢楼主分享!!!

ZYX2129 发表于 2022-12-3 13:08:29

感謝樓主分享,有点高大尚
页: [1] 2 3
查看完整版本: 文字动态伸缩(GIF展示)