求一个可动态调整单行/多行文字宽度比例并实时显示的程序

sanpoul

各位大侠，有时候需手动调整多个单行或多行文字的宽度比例，需多次ctrl+1调出特性框，再输入新的宽度比例，这样修改很慢，且有时候输入的比例也不知道是否合适，还需再调。手头上有lsp调整的程序，但还想能更智能，现想请大神编写能动态调整宽度比例的程序，如可用鼠标实时控制宽度并显示。万分感谢。
附：
(defun c:bgg(/ en ent entdata zhi nzhi shu)
   (setq p1 (getreal"输入新的宽度比例："))
  (setq en (entsel));只针对单行文字
  (setq entdata (entget (car en)))
  (print entdata);查看群码数值
  (setq zhi(assoc 41 entdata));群码41可以修改
  (setq shu (cdr zhi));原数值
  (setq nzhi (cons 41 p1));按群码41修改内容
  (setq entdata (subst nzhi zhi entdata))
  (entmod entdata)
  ;(princ shu)
  (princ)
)

fangseng

针对调整型单行字无效！！！

永不言弃

2. ;;逆流而上的鱼制作QQ736188807
   
3. ;;工具箱下载http://yunpan.cn/c3iAVqYptpwj9  访问密码 cc19
   
4. (defun c:tt nil
   
5.   (setq ss (ssget ":S" '((0 . "TEXT"))))
   
6.   (setq p0 (cdr (assoc 11 (entget (ssname ss 0)))))
   
7.   (setq ct 1)      
   
8.   (while (= ct 1)   
   
9.     (setq in (grread nil 5 0))   
   
10.     (setq i 0)
    
11.     (setq nn (sslength ss))
    
12.     (repeat nn
    
13.       (setq ssn (ssname ss i))
    
14.       (setq sn1 (entget ssn))
    
15.       (if (= 5 (car in))   
    
16.   (progn
    
17.     (setq pt (cadr in))
    
18.     (redraw)
    
19.     (grdraw p0 pt 3 2)
    
20.     (setq dis (/ (distance p0 pt) 10))
    
21.     (entmod (subst (cons 41 dis) (assoc 41 sn1) sn1))
    
22.   )
    
23.       )
    
24.       (if (= 3 (car in))
    
25.   (progn (setq pt (cadr in))
    
26.          (setq dis (/ (distance p0 pt) 10))
    
27.          (entmod (subst (cons 41 dis) (assoc 41 sn1) sn1))
    
28.          (redraw)
    
29.          (setq ct nil)
    
30.   )
    
31.       )
    
32.       (setq i (1+ i))
    
33.     )
    
34.   )
    
35.   
    
36. )
    
37. 
    
38. (print "欢迎使用《逆流而上的鱼制作QQ736188807》")(princ)
    
39. 
    

;;逆流而上的鱼制作QQ736188807<br /> ;;工具箱下载http://yunpan.cn/c3iAVqYptpwj9  访问密码 cc19<br /> (defun c:tt nil<br />   (setq ss (ssget ":S" '((0 . "TEXT"))))<br />   (setq p0 (cdr (assoc 11 (entget (ssname ss 0)))))<br />   (setq ct 1)      <br />   (while (= ct 1)    <br />     (setq in (grread nil 5 0))    <br />     (setq i 0)<br />     (setq nn (sslength ss))<br />     (repeat nn<br />       (setq ssn (ssname ss i))<br />       (setq sn1 (entget ssn))<br />       (if (= 5 (car in))    <br />   (progn<br />     (setq pt (cadr in))<br />     (redraw)<br />     (grdraw p0 pt 3 2)<br />     (setq dis (/ (distance p0 pt) 10))<br />     (entmod (subst (cons 41 dis) (assoc 41 sn1) sn1))<br />   )<br />       )<br />       (if (= 3 (car in))<br />   (progn (setq pt (cadr in))<br />          (setq dis (/ (distance p0 pt) 10))<br />          (entmod (subst (cons 41 dis) (assoc 41 sn1) sn1))<br />          (redraw)<br />          (setq ct nil)<br />   )<br />       )<br />       (setq i (1+ i))<br />     )<br />   )<br />   <br /> )<br /> <br /> (print "欢迎使用《逆流而上的鱼制作QQ736188807》")(princ)<br /> <br />

yoyoho

哇!动态的! 感谢 "永不言弃" 分享程序!

jltx123456

永不言弃 发表于 2016-5-19 11:33

本代码由不死猫老师编程工具自动打乱

有必要这样子吗？

bai2000

同意楼上说法

lucas_3333

多行文字没有宽度比例这个属性吧

取之于明，还之于明

给个例子吧

1. (defun c:tt (/ s p e gr)
   
2.   (if (setq s (ssget "_+.:S:E:L" '((0 . "TEXT"))))
   
3.     (progn
   
4.       (setq p (cdr (assoc 10 (entget (setq e (ssname s 0))))))
   
5.       (while (eq (car (setq gr (grread t 15 0))) 5)
   
6.         (redraw)
   
7.         (grdraw p (cadr gr) 1 -1)
   
8.         (vla-put-ScaleFactor
   
9.           (vlax-ename->vla-object e)
   
10.           (distance p (cadr gr))
    
11.          )
    
12.       )
    
13.       (redraw)
    
14.     )
    
15.   )
    
16.   (princ)
    
17. )
    
18. (vl-load-com)

(defun c:tt (/ s p e gr)<br />   (if (setq s (ssget "_+.:S:E:L" '((0 . "TEXT"))))<br />     (progn<br />       (setq p (cdr (assoc 10 (entget (setq e (ssname s 0))))))<br />       (while (eq (car (setq gr (grread t 15 0))) 5)<br />         (redraw)<br />         (grdraw p (cadr gr) 1 -1)<br />         (vla-put-ScaleFactor<br />           (vlax-ename->vla-object e)<br />           (distance p (cadr gr))<br />          )<br />       )<br />       (redraw)<br />     )<br />   )<br />   (princ)<br /> )<br /> (vl-load-com)

冒个烟圈

说的好，，。。。。

feng83

学习下

feng83

编了个针对单个单行文本编辑器，看是否能满足你的要求
(defun c:tt(/ en entdata p gr w ww)
  (setq en (entsel))
  (setq entdata (entget (car en)))
  (if (wcmatch (cdr(assoc 0 entdata)) "TEXT")
    (progn
      (setq p (cdr(assoc 10 entdata)))
      (while (and (setq gr (grread 5))(= (car gr) 5))
        (setq w (car(cdr gr)))
        (setq ww (abs (-(car p)(car w))))
        (entmod (subst (cons 41 ww) (assoc 41 entdata) entdata))
        (entupd (cdr (assoc -1 entdata)))
        ))
    (princ "类型错误：")
    )
  (princ)
)

lxw320

同意楼上说法