单行文本动态伸缩
本帖最后由 尘缘一生 于 2024-7-4 14:38 编辑这个就不用解释了，然不同是什么呢？我不知道才发帖，你不知道请你闭嘴，别回复，下载。
三领设计 V3.0 永久下载地址：
链接：https://pan.baidu.com/s/1WsH2nmBHUhb0T3STais1Hg
提取码：i2uj
不错，代码简练，不过运行出现“参数太少”，楼主检查一下 本帖最后由 尘缘一生 于 2024-7-4 16:38 编辑
bai2000 发表于 2024-7-4 16:01
不错，代码简练，不过运行出现“参数太少”，楼主检查一下
不会吧？等我完善看看，刚刚换成函数做法，比较下子
;根据 lstSub 子表中的首元素 替换 lstSource 中对应表元-----(一级)--------
;lstSub需要替换的列表 lstSource源列表 bAdd是否向源列表中追加 原本没有的元素
(defun sl:list-substassoc (lstSublstSourcebAdd / e e1)
(foreach e lstSub
(if (setq e1 (assoc (car e) lstSource))
(setq lstSource (subst e (assoc (car e) lstSource) lstSource))
(if bAdd (setq lstSource (append lstSource (list e))))
)
)
lstSource
)
;原位修改文字对齐方式---(一级)----
;注：代码出处 "信.工具箱"Modify by 尘缘一生QQ:15290049 2024.7.4
(defun text:alignmod (nam mode / p10 p11 ent box b ang)
(setq ent (entget nam))
(setq p10 (dxf1 ent 10))
(setq b (cadr (textbox ent)))
(setq ang (dxf1 ent 50))
(setq ent
(entmod
(cond
((= (strcase mode) "L") ;左对齐
(sl:list-substassoc (list (cons 10 p10) '(72 . 0) '(73 . 0)) ent t)
)
((= (strcase mode) "C") ;中对齐
(sl:list-substassoc (list (cons 11 p10) '(72 . 1) '(73 . 0)) ent t)
)
((= (strcase mode) "R") ;右对齐
(sl:list-substassoc (list (cons 11 p10) '(72 . 2) '(73 . 0)) ent t)
)
((= (strcase mode) "M") ;中心对齐
(sl:list-substassoc (list (cons 11 p10) '(72 . 4) '(73 . 0)) ent t)
)
((= (strcase mode) "A") ;对齐
(setq p11 (polar p10 ang (car b)))
(sl:list-substassoc (list (cons 10 p10) (cons 11 p11) '(72 . 3) '(73 . 0)) ent t)
)
((= (strcase mode) "F") ;调整
(setq p11 (polar p10 ang (car b)))
(sl:list-substassoc (list (cons 10 p10) (cons 11 p11) '(72 . 5) '(73 . 0)) ent t)
)
((= (strcase mode) "BL") ;左下
(sl:list-substassoc (list (cons 11 p10) '(72 . 0) '(73 . 1)) ent t)
)
((= (strcase mode) "BC") ;中下
(sl:list-substassoc (list (cons 11 p10) '(72 . 1) '(73 . 1)) ent t)
)
((= (strcase mode) "BR") ;右下
(sl:list-substassoc (list (cons 11 p10) '(72 . 2) '(73 . 1)) ent t)
)
((= (strcase mode) "ML") ;左中
(sl:list-substassoc (list (cons 11 p10) '(72 . 0) '(73 . 2)) ent t)
)
((= (strcase mode) "MC") ;正中
(sl:list-substassoc (list (cons 11 p10) '(72 . 1) '(73 . 2)) ent t)
)
((= (strcase mode) "MR") ;右中
(sl:list-substassoc (list (cons 11 p10) '(72 . 2) '(73 . 2)) ent t)
)
((= (strcase mode) "tL") ;左上
(sl:list-substassoc (list (cons 11 p10) '(72 . 0) '(73 . 3)) ent t)
)
((= (strcase mode) "tC") ;中上
(sl:list-substassoc (list (cons 11 p10) '(72 . 1) '(73 . 3)) ent t)
)
((= (strcase mode) "tR") ;右上
(sl:list-substassoc (list (cons 11 p10) '(72 . 2) '(73 . 3)) ent t)
)
(t ent)
)
)
)
(setq ent (entget (dxf1 ent -1)))
(setq p11 (mapcar '+ (mapcar '- p10 (dxf1 ent 10)) (dxf1 ent 11)))
(entmod (sl:list-substassoc (list (cons 10 p10) (cons 11 p11)) ent t))
)
;;单行TEXT文本选择集-动态拉伸---(一级)----
;;功能 程序去除文字的前面空格，后面的空格，进行动态伸缩，保持角度，定位点不变
;三领设计 V3.0 Modify by 尘缘一生QQ:15290049 2024.7.4(精简后代码)
(defun macedit-text (ss / pt gr loop enam n i ang ent tx p p1)
(defun sskk (ss pt)
(repeat (setq n (sslength ss))
(setq enam (ssname ss (setq n (1- n))))
(setq ent (entget enam) p (dxf1 ent 10) tx (dxf1 ent 1) ang (dxf1 ent 50) p1 (polar p ang 300.0))
(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))
)
(entmod (emod (emod (emod (emod ent 1 tx) 11 (pertolinecz pt p p1)) 72 5) 73 0)) ;变F(双穴点)定位,去前后空格,确保右侧对齐光标点
;(if (if-color) (vla-put-color (en2obj enam) (atoi (slsjqs)))) ;此为三领集成，变色系统，可忽略
)
)
;;-----------------
(princ"\n 动态拉伸>>>:")
(setq loop t)
(while loop
(setq gr (grread t 15 0) pt (cadr gr))
(cond
((= (car gr) 5)
(sskk ss pt)
)
((member (car gr) '(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)
)
陈总威武啊， 这个挺不错的哈 好東西，謝謝分享，感謝!!! Thanks for sharing 好東西，謝謝分享，感謝!!! 感谢分享，很实用 不知道启动命令
页:
[1]