【RTB】分解缩放块的同时,恢复块内文字状态

kucha007

需求来自这里：
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=187696&fromuid=7329538

1. ;分解缩放块的同时,恢复块内文字状态 by kucha
   
2. (defun C:RTB (/ Old_Cmd K:DXF Blk SCVar SS i en TmeVar)
   
3.   (setq Old_Cmd (getvar "cmdecho"))
   
4.   (defun K:DXF (key en) (cdr (assoc key (entget en))))
   
5.   (command "undo" "be");记录编组
   
6.     (setvar "cmdecho" 0)
   
7.     (if
   
8.       (and
   
9.         (setq Blk (car (entsel "\n→请点选块: ")))
   
10.         (eq (K:DXF 0 Blk) "INSERT")
    
11.       )
    
12.       (progn
    
13.         (setq SCVar (list (K:DXF 42 Blk) (/ (K:DXF 41 Blk) (K:DXF 42 Blk))));高宽
    
14.         (command "Explode" Blk)
    
15.         (setq SS (ssget "p"))
    
16.         (repeat (setq i (sslength SS))
    
17.           (setq en (ssname SS (setq i (1- i))))
    
18.           (if (eq (K:DXF 0 en) "TEXT")
    
19.             (progn
    
20.               (setq TmeVar (mapcar '(lambda (x y) (/ x y))
    
21.                                   (list (K:DXF 40 en) (K:DXF 41 en));高宽
    
22.                                   SCVar
    
23.                           )
    
24.               )
    
25.               (entmod (subst (cons 40 (car TmeVar)) (assoc 40 (entget en)) (entget en)))
    
26.               (entmod (subst (cons 41 (cadr TmeVar)) (assoc 41 (entget en)) (entget en)))
    
27.             )
    
28.           )
    
29.         )
    
30.         (princ (strcat "\n——★★★ 块内文字已恢复到缩放前的状态 ★★★——"))
    
31.       )
    
32.       (princ (strcat "\n——★★★ 请选择块对象! ★★★——"))
    
33.     )
    
34.     (setvar "cmdecho" Old_Cmd)
    
35.   (command "undo" "e");结束编组
    
36.   (princ)
    
37. )

;分解缩放块的同时,恢复块内文字状态 by kucha<br /> (defun C:RTB (/ Old_Cmd K:DXF Blk SCVar SS i en TmeVar) <br />   (setq Old_Cmd (getvar "cmdecho"))<br />   (defun K:DXF (key en) (cdr (assoc key (entget en))))<br />   (command "undo" "be");记录编组<br />     (setvar "cmdecho" 0)<br />     (if<br />       (and<br />         (setq Blk (car (entsel "\n→请点选块: ")))<br />         (eq (K:DXF 0 Blk) "INSERT") <br />       )<br />       (progn<br />         (setq SCVar (list (K:DXF 42 Blk) (/ (K:DXF 41 Blk) (K:DXF 42 Blk))));高宽<br />         (command "Explode" Blk)<br />         (setq SS (ssget "p"))<br />         (repeat (setq i (sslength SS)) <br />           (setq en (ssname SS (setq i (1- i))))<br />           (if (eq (K:DXF 0 en) "TEXT") <br />             (progn <br />               (setq TmeVar (mapcar '(lambda (x y) (/ x y)) <br />                                   (list (K:DXF 40 en) (K:DXF 41 en));高宽<br />                                   SCVar<br />                           )<br />               )<br />               (entmod (subst (cons 40 (car TmeVar)) (assoc 40 (entget en)) (entget en)))<br />               (entmod (subst (cons 41 (cadr TmeVar)) (assoc 41 (entget en)) (entget en)))<br />             )<br />           )<br />         )<br />         (princ (strcat "\n——★★★ 块内文字已恢复到缩放前的状态 ★★★——"))<br />       )<br />       (princ (strcat "\n——★★★ 请选择块对象! ★★★——"))<br />     )<br />     (setvar "cmdecho" Old_Cmd)<br />   (command "undo" "e");结束编组<br />   (princ)<br /> )

nsh935

谢谢大神分享

kucha007

cchessbd 发表于 2023-4-27 12:30
感谢大侠，测试了一下，能够恢复文字原大小，就是相对位置移位了。。。

我先保存下，再来研究吧……感谢 ...

编块前你需要用justifytext命令改一下文字对齐点，有些文字需要改成右对齐

cchessbd

感谢大侠，测试了一下，能够恢复文字原大小，就是相对位置移位了。。。

我先保存下，再来研究吧……感谢大侠出手。小弟佩服不已！

e2002

这种情况用Attrib才是合理的做法。

cchessbd

kucha007 发表于 2023-4-27 13:22
编块前你需要用justifytext命令改一下文字对齐点，有些文字需要改成右对齐

谢谢老大，我试一试。之前好像眼睛瞎了，没看到。。。
justifytext
justifytext
justifytext

cchessbd

e2002 发表于 2023-4-27 14:15
这种情况用Attrib才是合理的做法。

元素太多，文字需要及时调整位置，打印才能看清楚。
有时间试一试块啥区别，谢谢大哥热心回复。

Noangler

谢谢分享，学习一下！