单行文本动态伸缩

尘缘一生

这个就不用解释了，然不同是什么呢？我不知道才发帖，你不知道请你闭嘴，别回复，下载。




三领设计 V3.0 永久下载地址：

链接：https://pan.baidu.com/s/1WsH2nmBHUhb0T3STais1Hg
提取码：i2uj

bai2000

不错，代码简练，不过运行出现“参数太少”，楼主检查一下

尘缘一生

bai2000 发表于 2024-7-4 16:01
不错，代码简练，不过运行出现“参数太少”，楼主检查一下

不会吧？等我完善看看，刚刚换成函数做法，比较下子

2. ;根据 lstSub 子表中的首元素 替换 lstSource 中对应表元-----(一级)--------
   
3. ;lstSub需要替换的列表   lstSource源列表   bAdd是否向源列表中追加 原本没有的元素
   
4. (defun sl:list-substassoc (lstSub  lstSource  bAdd / e e1)
   
5.   (foreach e lstSub
   
6.     (if (setq e1 (assoc (car e) lstSource))
   
7.       (setq lstSource (subst e (assoc (car e) lstSource) lstSource))
   
8.       (if bAdd (setq lstSource (append lstSource (list e))))
   
9.     )
   
10.   )
    
11.   lstSource
    
12. )
    
13. ;原位修改文字对齐方式---(一级)----
    
14. ;注：代码出处 "信.工具箱"  Modify by 尘缘一生  QQ:15290049 2024.7.4
    
15. (defun text:alignmod (nam mode / p10 p11 ent box b ang)
    
16.   (setq ent (entget nam))
    
17.   (setq p10 (dxf1 ent 10))
    
18.   (setq b (cadr (textbox ent)))
    
19.   (setq ang (dxf1 ent 50))
    
20.   (setq ent
    
21.     (entmod
    
22.       (cond
    
23.         ((= (strcase mode) "L") ;左对齐
    
24.           (sl:list-substassoc (list (cons 10 p10) '(72 . 0) '(73 . 0)) ent t)
    
25.         )
    
26.         ((= (strcase mode) "C") ;中对齐
    
27.           (sl:list-substassoc (list (cons 11 p10) '(72 . 1) '(73 . 0)) ent t)
    
28.         )
    
29.         ((= (strcase mode) "R") ;右对齐
    
30.           (sl:list-substassoc (list (cons 11 p10) '(72 . 2) '(73 . 0)) ent t)
    
31.         )
    
32.         ((= (strcase mode) "M") ;中心对齐
    
33.           (sl:list-substassoc (list (cons 11 p10) '(72 . 4) '(73 . 0)) ent t)
    
34.         )
    
35.         ((= (strcase mode) "A") ;对齐
    
36.           (setq p11 (polar p10 ang (car b)))
    
37.           (sl:list-substassoc (list (cons 10 p10) (cons 11 p11) '(72 . 3) '(73 . 0)) ent t)
    
38.         )
    
39.         ((= (strcase mode) "F") ;调整
    
40.           (setq p11 (polar p10 ang (car b)))
    
41.           (sl:list-substassoc (list (cons 10 p10) (cons 11 p11) '(72 . 5) '(73 . 0)) ent t)
    
42.         )
    
43.         ((= (strcase mode) "BL") ;左下
    
44.           (sl:list-substassoc (list (cons 11 p10) '(72 . 0) '(73 . 1)) ent t)
    
45.         )
    
46.         ((= (strcase mode) "BC") ;中下
    
47.           (sl:list-substassoc (list (cons 11 p10) '(72 . 1) '(73 . 1)) ent t)
    
48.         )
    
49.         ((= (strcase mode) "BR") ;右下
    
50.           (sl:list-substassoc (list (cons 11 p10) '(72 . 2) '(73 . 1)) ent t)
    
51.         )
    
52.         ((= (strcase mode) "ML") ;左中
    
53.           (sl:list-substassoc (list (cons 11 p10) '(72 . 0) '(73 . 2)) ent t)
    
54.         )
    
55.         ((= (strcase mode) "MC") ;正中
    
56.           (sl:list-substassoc (list (cons 11 p10) '(72 . 1) '(73 . 2)) ent t)
    
57.         )
    
58.         ((= (strcase mode) "MR") ;右中
    
59.           (sl:list-substassoc (list (cons 11 p10) '(72 . 2) '(73 . 2)) ent t)
    
60.         )
    
61.         ((= (strcase mode) "tL") ;左上
    
62.           (sl:list-substassoc (list (cons 11 p10) '(72 . 0) '(73 . 3)) ent t)
    
63.         )
    
64.         ((= (strcase mode) "tC") ;中上
    
65.           (sl:list-substassoc (list (cons 11 p10) '(72 . 1) '(73 . 3)) ent t)
    
66.         )
    
67.         ((= (strcase mode) "tR") ;右上
    
68.           (sl:list-substassoc (list (cons 11 p10) '(72 . 2) '(73 . 3)) ent t)
    
69.         )
    
70.         (t ent)
    
71.       )
    
72.     )
    
73.   )
    
74.   (setq ent (entget (dxf1 ent -1)))
    
75.   (setq p11 (mapcar '+ (mapcar '- p10 (dxf1 ent 10)) (dxf1 ent 11)))
    
76.   (entmod (sl:list-substassoc (list (cons 10 p10) (cons 11 p11)) ent t))
    
77. )
    
78. ;;单行TEXT文本选择集-动态拉伸---(一级)----
    
79. ;;功能 程序去除文字的前面空格，后面的空格，进行动态伸缩，保持角度，定位点不变
    
80. ;三领设计 V3.0 Modify by 尘缘一生  QQ:15290049 2024.7.4  (精简后代码)
    
81. (defun macedit-text (ss / pt gr loop enam n i ang ent tx p p1)
    
82.   (defun sskk (ss pt)
    
83.     (repeat (setq n (sslength ss))
    
84.       (setq enam (ssname ss (setq n (1- n))))
    
85.       (setq ent (entget enam) p (dxf1 ent 10) tx (dxf1 ent 1) ang (dxf1 ent 50) p1 (polar p ang 300.0))
    
86.       (while (= (substr tx 1 1) " ") ;文字前去空格
    
87.         (setq tx (substr tx 2))
    
88.       )
    
89.       (setq i (strlen tx))
    
90.       (while (= (substr tx i 1) " ");文字后去空格
    
91.         (setq tx (substr tx 1 (1- i)) i  (strlen tx))
    
92.       )
    
93.       (entmod (emod (emod (emod (emod ent 1 tx) 11 (pertolinecz pt p p1)) 72 5) 73 0)) ;变F(双穴点)定位,去前后空格,确保右侧对齐光标点
    
94.       ;(if (if-color) (vla-put-color (en2obj enam) (atoi (slsjqs)))) ;此为三领集成，变色系统，可忽略
    
95.     )
    
96.   )
    
97.   ;;-----------------
    
98.   (princ"\n 动态拉伸>>>:")
    
99.   (setq loop t)
    
100.   (while loop
     
101.     (setq gr (grread t 15 0) pt (cadr gr))
     
102.     (cond
     
103.       ((= (car gr) 5)
     
104.         (sskk ss pt)
     
105.       )
     
106.       ((member (car gr) '(3 11 25))  ;;左键 右键
     
107.         (setq loop nil)
     
108.       )
     
109.     )
     
110.   )
     
111.   (while (setq enam (ssname ss 0)) ;等同于(vl-cmdf "_.JustifyText" ss "" "L")
     
112.     (text:alignmod enam "L")
     
113.     (ssdel enam ss)
     
114.   )
     
115.   (princ)
     
116. )

;根据 lstSub 子表中的首元素 替换 lstSource 中对应表元-----(一级)--------<br /> ;lstSub需要替换的列表   lstSource源列表   bAdd是否向源列表中追加 原本没有的元素<br /> (defun sl:list-substassoc (lstSub  lstSource  bAdd / e e1)<br />   (foreach e lstSub<br />     (if (setq e1 (assoc (car e) lstSource))<br />       (setq lstSource (subst e (assoc (car e) lstSource) lstSource))<br />       (if bAdd (setq lstSource (append lstSource (list e))))<br />     )<br />   )<br />   lstSource<br /> ) <br /> ;原位修改文字对齐方式---(一级)----<br /> ;注：代码出处 "信.工具箱"  Modify by 尘缘一生  QQ:15290049 2024.7.4<br /> (defun text:alignmod (nam mode / p10 p11 ent box b ang)<br />   (setq ent (entget nam))<br />   (setq p10 (dxf1 ent 10))<br />   (setq b (cadr (textbox ent)))<br />   (setq ang (dxf1 ent 50))<br />   (setq ent<br />     (entmod<br />       (cond<br />         ((= (strcase mode) "L") ;左对齐<br />           (sl:list-substassoc (list (cons 10 p10) '(72 . 0) '(73 . 0)) ent t)<br />         )<br />         ((= (strcase mode) "C") ;中对齐<br />           (sl:list-substassoc (list (cons 11 p10) '(72 . 1) '(73 . 0)) ent t)<br />         )<br />         ((= (strcase mode) "R") ;右对齐<br />           (sl:list-substassoc (list (cons 11 p10) '(72 . 2) '(73 . 0)) ent t)<br />         )<br />         ((= (strcase mode) "M") ;中心对齐<br />           (sl:list-substassoc (list (cons 11 p10) '(72 . 4) '(73 . 0)) ent t)<br />         )<br />         ((= (strcase mode) "A") ;对齐<br />           (setq p11 (polar p10 ang (car b)))<br />           (sl:list-substassoc (list (cons 10 p10) (cons 11 p11) '(72 . 3) '(73 . 0)) ent t)<br />         )<br />         ((= (strcase mode) "F") ;调整<br />           (setq p11 (polar p10 ang (car b)))<br />           (sl:list-substassoc (list (cons 10 p10) (cons 11 p11) '(72 . 5) '(73 . 0)) ent t)<br />         )<br />         ((= (strcase mode) "BL") ;左下<br />           (sl:list-substassoc (list (cons 11 p10) '(72 . 0) '(73 . 1)) ent t)<br />         )<br />         ((= (strcase mode) "BC") ;中下<br />           (sl:list-substassoc (list (cons 11 p10) '(72 . 1) '(73 . 1)) ent t)<br />         )<br />         ((= (strcase mode) "BR") ;右下<br />           (sl:list-substassoc (list (cons 11 p10) '(72 . 2) '(73 . 1)) ent t)<br />         )<br />         ((= (strcase mode) "ML") ;左中<br />           (sl:list-substassoc (list (cons 11 p10) '(72 . 0) '(73 . 2)) ent t)<br />         )<br />         ((= (strcase mode) "MC") ;正中<br />           (sl:list-substassoc (list (cons 11 p10) '(72 . 1) '(73 . 2)) ent t)<br />         )<br />         ((= (strcase mode) "MR") ;右中<br />           (sl:list-substassoc (list (cons 11 p10) '(72 . 2) '(73 . 2)) ent t)<br />         )<br />         ((= (strcase mode) "tL") ;左上<br />           (sl:list-substassoc (list (cons 11 p10) '(72 . 0) '(73 . 3)) ent t)<br />         )<br />         ((= (strcase mode) "tC") ;中上<br />           (sl:list-substassoc (list (cons 11 p10) '(72 . 1) '(73 . 3)) ent t)<br />         )<br />         ((= (strcase mode) "tR") ;右上<br />           (sl:list-substassoc (list (cons 11 p10) '(72 . 2) '(73 . 3)) ent t)<br />         )<br />         (t ent)<br />       )<br />     )<br />   )<br />   (setq ent (entget (dxf1 ent -1)))<br />   (setq p11 (mapcar '+ (mapcar '- p10 (dxf1 ent 10)) (dxf1 ent 11)))<br />   (entmod (sl:list-substassoc (list (cons 10 p10) (cons 11 p11)) ent t))<br /> )<br /> ;;单行TEXT文本选择集-动态拉伸---(一级)----<br /> ;;功能 程序去除文字的前面空格，后面的空格，进行动态伸缩，保持角度，定位点不变<br /> ;三领设计 V3.0 Modify by 尘缘一生  QQ:15290049 2024.7.4  (精简后代码)<br /> (defun macedit-text (ss / pt gr loop enam n i ang ent tx p p1)<br />   (defun sskk (ss pt)<br />     (repeat (setq n (sslength ss))<br />       (setq enam (ssname ss (setq n (1- n))))<br />       (setq ent (entget enam) p (dxf1 ent 10) tx (dxf1 ent 1) ang (dxf1 ent 50) p1 (polar p ang 300.0))<br />       (while (= (substr tx 1 1) " ") ;文字前去空格<br />         (setq tx (substr tx 2))<br />       )<br />       (setq i (strlen tx))<br />       (while (= (substr tx i 1) " ");文字后去空格<br />         (setq tx (substr tx 1 (1- i)) i  (strlen tx))<br />       )<br />       (entmod (emod (emod (emod (emod ent 1 tx) 11 (pertolinecz pt p p1)) 72 5) 73 0)) ;变F(双穴点)定位,去前后空格,确保右侧对齐光标点<br />       ;(if (if-color) (vla-put-color (en2obj enam) (atoi (slsjqs)))) ;此为三领集成，变色系统，可忽略<br />     )<br />   )<br />   ;;-----------------<br />   (princ"\n 动态拉伸>>>:")<br />   (setq loop t)<br />   (while loop<br />     (setq gr (grread t 15 0) pt (cadr gr))<br />     (cond<br />       ((= (car gr) 5)<br />         (sskk ss pt)<br />       )<br />       ((member (car gr) '(3 11 25))  ;;左键 右键<br />         (setq loop nil)<br />       )<br />     )<br />   )<br />   (while (setq enam (ssname ss 0)) ;等同于(vl-cmdf "_.JustifyText" ss "" "L")<br />     (text:alignmod enam "L")<br />     (ssdel enam ss)<br />   )<br />   (princ)<br /> )

hubeiwdlue

陈总威武啊，

gble119

这个挺不错的哈

taiwanfox

好東西，謝謝分享，感謝!!!

ketxu

Thanks for sharing

taiwanfox

好東西，謝謝分享，感謝!!!

paulpipi

感谢分享，很实用

13023355666

不知道启动命令