【RTB】分解缩放块的同时,恢复块内文字状态
本帖最后由 kucha007 于 2023-4-26 22:17 编辑需求来自这里：
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=187696&fromuid=7329538
;分解缩放块的同时,恢复块内文字状态 by kucha
(defun C:RTB (/ Old_Cmd K:DXF Blk SCVar SS i en TmeVar)
(setq Old_Cmd (getvar "cmdecho"))
(defun K:DXF (key en) (cdr (assoc key (entget en))))
(command "undo" "be");记录编组
(setvar "cmdecho" 0)
(if
(and
(setq Blk (car (entsel "\n→请点选块: ")))
(eq (K:DXF 0 Blk) "INSERT")
)
(progn
(setq SCVar (list (K:DXF 42 Blk) (/ (K:DXF 41 Blk) (K:DXF 42 Blk))));高宽
(command "Explode" Blk)
(setq SS (ssget "p"))
(repeat (setq i (sslength SS))
(setq en (ssname SS (setq i (1- i))))
(if (eq (K:DXF 0 en) "TEXT")
(progn
(setq TmeVar (mapcar '(lambda (x y) (/ x y))
(list (K:DXF 40 en) (K:DXF 41 en));高宽
SCVar
)
)
(entmod (subst (cons 40 (car TmeVar)) (assoc 40 (entget en)) (entget en)))
(entmod (subst (cons 41 (cadr TmeVar)) (assoc 41 (entget en)) (entget en)))
)
)
)
(princ (strcat "\n——★★★ 块内文字已恢复到缩放前的状态 ★★★——"))
)
(princ (strcat "\n——★★★ 请选择块对象! ★★★——"))
)
(setvar "cmdecho" Old_Cmd)
(command "undo" "e");结束编组
(princ)
)
谢谢大神分享 本帖最后由 kucha007 于 2023-4-27 13:23 编辑
cchessbd 发表于 2023-4-27 12:30
感谢大侠，测试了一下，能够恢复文字原大小，就是相对位置移位了。。。
我先保存下，再来研究吧……感谢 ...
编块前你需要用justifytext命令改一下文字对齐点，有些文字需要改成右对齐 本帖最后由 cchessbd 于 2023-4-27 12:34 编辑
感谢大侠，测试了一下，能够恢复文字原大小，就是相对位置移位了。。。
我先保存下，再来研究吧……感谢大侠出手。小弟佩服不已！
这种情况用Attrib才是合理的做法。
kucha007 发表于 2023-4-27 13:22
编块前你需要用justifytext命令改一下文字对齐点，有些文字需要改成右对齐
谢谢老大，我试一试。之前好像眼睛瞎了，没看到。。。
justifytext
justifytext
justifytext e2002 发表于 2023-4-27 14:15
这种情况用Attrib才是合理的做法。
元素太多，文字需要及时调整位置，打印才能看清楚。
有时间试一试块啥区别，谢谢大哥热心回复。 谢谢分享，学习一下！ 感谢作者的分享！
页:
[1]