[讨论]：缩放实体保持文字大小－－拖曳效果

陌生人

请做出以下效果的lsp
缩放实体，文字高度大小不变。
难点：过程中需支持直观的缩放（拖曳）效果（如同scale命令过程）。（因robo也无法将拖曳状态捕捉下来，示意里面看不到：（）

心梦相随

这个应该难不倒陌生人长老呀，
LISP用grread与scall对其他实体进行实时修正，文字用entmod修正。
ARX你应该很强，或许还有别的办法。

陌生人

我已经写出来了，1楼就是测试效果。我是想让有兴趣的人也来玩玩：）
顺便说一句，我没有用grread，也没有用entmod，arx我是文盲。

chstart

呵，长老能把程序贴上来看看吗？挺有意思的。
每次看你的程序都是一种享受，简洁高深。

心梦相随

长老也忒谦虚，长老应该算是编程高手了
长老能否把贴子发出来？让俺也学学，谢谢先。

lzy9788

是啊，长老，让在家来借鉴借鉴吧。

陌生人

唉！～没人一起来玩，太没意思了：（

LUCAS

最初由 陌生人 发布
[B]我已经写出来了，1楼就是测试效果。我是想让有兴趣的人也来玩玩：）
顺便说一句，我没有用grread，也没有用entmod，arx我是文盲。 [/B]

没有用grread，也没有用entmod,那（拖曳）效果的第2參考點是甚麼?沒有提供測試程序看不出你要甚麼?

陌生人

就是模拟scale命令，缩放后，把字高改回原来的大小：）

加载sc2.vlx,
命令:sc2
试用（R）选项

LUCAS

2. 
   
3. ;;那太簡單了吧!比較text前後字高即可!
   
4. (defun C:SC2 (/ HOLDECHO SS SS1 ENT)
   
5.   (prompt
   
6.     "\n縮放,保留文字大小TYPE "SC2" V0-------- by 龍龍仔.2004.5"
   
7.   )
   
8.   (prompt "\n選擇實體: ")
   
9.   (setq SS (ssget))
   
10.   (if (setq SS1 (ssget "p" '((0 . "*text"))))
    
11.     (setq HI (vla-get-height
    
12.                (setq EN (vlax-ename->vla-object (ssname SS1 0)))
    
13.              )
    
14.     )
    
15.   )
    
16.   (if SS
    
17.     (progn
    
18.       (setq HOLDECHO (getvar "CMDECHO"))
    
19.       (setvar "CMDECHO" 0)
    
20.       (command "_.UNDO" "_GROUP")
    
21.       (setvar "cmdecho" 1)
    
22.       (command "_.SCALE" SS "")
    
23.       (while (/= 0 (getvar "cmdactive")) (command PAUSE))
    
24.       (setvar "cmdecho" 0)
    
25.       (if SS1
    
26.         (progn
    
27.           (setq HI (/ HI (vla-get-height EN)))
    
28.           (setq N 0)
    
29.           (repeat (sslength SS1)
    
30.             (setq ENT (vlax-ename->vla-object (ssname SS1 N)))
    
31.             (vla-put-height ENT (* HI (vla-get-height ENT)))
    
32.             (setq N (1+ N))
    
33.           )
    
34.         )
    
35.       )
    
36.     )
    
37.   )
    
38.   (command "_.UNDO" "_END")
    
39.   (setvar "CMDECHO" HOLDECHO)
    
40.   (princ)
    
41. )
    

<br /> ;;那太簡單了吧!比較text前後字高即可! <br /> (defun C:SC2 (/ HOLDECHO SS SS1 ENT)<br />   (prompt<br />     "\n縮放,保留文字大小TYPE "SC2" V0-------- by 龍龍仔.2004.5"<br />   )<br />   (prompt "\n選擇實體: ")<br />   (setq SS (ssget))<br />   (if (setq SS1 (ssget "p" '((0 . "*text"))))<br />     (setq HI (vla-get-height<br />                (setq EN (vlax-ename->vla-object (ssname SS1 0)))<br />              )<br />     )<br />   )<br />   (if SS<br />     (progn<br />       (setq HOLDECHO (getvar "CMDECHO"))<br />       (setvar "CMDECHO" 0)<br />       (command "_.UNDO" "_GROUP")<br />       (setvar "cmdecho" 1)<br />       (command "_.SCALE" SS "")<br />       (while (/= 0 (getvar "cmdactive")) (command PAUSE))<br />       (setvar "cmdecho" 0)<br />       (if SS1<br />         (progn<br />           (setq HI (/ HI (vla-get-height EN)))<br />           (setq N 0)<br />           (repeat (sslength SS1)<br />             (setq ENT (vlax-ename->vla-object (ssname SS1 N)))<br />             (vla-put-height ENT (* HI (vla-get-height ENT)))<br />             (setq N (1+ N))<br />           )<br />         )<br />       )<br />     )<br />   )<br />   (command "_.UNDO" "_END")<br />   (setvar "CMDECHO" HOLDECHO)<br />   (princ)<br /> )<br />

陌生人

对了，lucas，你觉得用undo －group －end 和undo be, e哪个爽一点？
谢谢龙龙仔参与讨论，付上我的源程序：(有时我也喜欢直接用命令:)，用scaletext一来图省事，二来对mtext也有效 ),其中缩放用了dxf10，未经验证，应该没问题吧？呵呵

2. 
   
3. ;;sc2 = 缩放,保留文字大小v1.2
   
4. 
   
5. (defun c:sc2 (/ oc ss e1 p1 p0 p2 sc)
   
6. (princ "\n缩放,保留文字大小v1.2------------------------------ by 陌生人.2004.5   \n选择实体:")
   
7. (vl-cmdf "_.undo" "be")
   
8. (setq oc (getvar "cmdecho")
   
9.        ss (ssget)
   
10.        e1 (ssname ss 0)
    
11.        p1 (cdr(assoc 10 (entget e1))))
    
12. (setvar "cmdecho" 1)
    
13. (vl-cmdf "_.scale" ss "" (setq p0 (getpoint "\n缩放基点:")))
    
14. (while (/= "" (getvar "CMDNAMES"))(vl-cmdf pause))
    
15. (setq p2 (cdr(assoc 10 (entget e1)))
    
16.        sc (/(distance p2 p0)(distance p1 p0)))
    
17. (setvar "cmdecho" 0)
    
18. (vl-cmdf "_.scaletext" (ssget "P" '((0 . "*TEXT"))) ""  "" "s" (/ 1 sc))
    
19. (setvar "cmdecho" oc)
    
20. (vl-cmdf "_.undo" "e")
    
21. (princ)
    
22. )
    

<br /> ;;sc2 = 缩放,保留文字大小v1.2<br /> <br /> (defun c:sc2 (/ oc ss e1 p1 p0 p2 sc)<br /> (princ "\n缩放,保留文字大小v1.2------------------------------ by 陌生人.2004.5   \n选择实体:")<br /> (vl-cmdf "_.undo" "be") <br /> (setq oc (getvar "cmdecho")<br />        ss (ssget)<br />        e1 (ssname ss 0)<br />        p1 (cdr(assoc 10 (entget e1))))<br /> (setvar "cmdecho" 1)<br /> (vl-cmdf "_.scale" ss "" (setq p0 (getpoint "\n缩放基点:")))<br /> (while (/= "" (getvar "CMDNAMES"))(vl-cmdf pause)) <br /> (setq p2 (cdr(assoc 10 (entget e1))) <br />        sc (/(distance p2 p0)(distance p1 p0))) <br /> (setvar "cmdecho" 0)<br /> (vl-cmdf "_.scaletext" (ssget "P" '((0 . "*TEXT"))) ""  "" "s" (/ 1 sc))<br /> (setvar "cmdecho" oc)<br /> (vl-cmdf "_.undo" "e") <br /> (princ)<br /> )<br />

litss

:(
没看到所说的实时拖拽效果，输入基点后，图形无变化。
另，如果输入基点后，跟着输入小于1的变化比例，如0.5，则文字还是跟着变小了，并没有实现程序的文字重新放大功能，为什么？程序对于大于1的变化比例，如果不是整数，如1.5，同样达不到效果。

GTJ116600

不知道最后怎么样了