框选中《标注》文字 在文字中间画一条直线 然后输入新的标注并写在原有标注的上方

zzmm

起始的标注
运行LISP程序
框选中标注文字  例：50
在框选中的标注文字中心画线
用户自行输入需要更改的文字 并写在旧文字的上方
循环 框选 画线 写文字
当不用更改的时候
按esc键退出
更改过后的图样

Gu_xl

1. (defun c:tt  (/ E MTEXT DIM DIMOBJ CP W H ROT STR TEXT)
   
2.   (while (and
   
3.         (setq e (nentsel "\n**选择标注文字:"))
   
4.         (setq mtext (car e))
   
5.         (= "MTEXT" (cdr (assoc 0 (setq mtext (entget mtext)))))
   
6.         )
   
7.       (setq text nil)
   
8.       (vla-GetBoundingBox
   
9.         (vlax-ename->vla-object (car e))
   
10.         'll
    
11.         'ur)
    
12.       (setq cp (mapcar '*
    
13.                        '(0.5 0.5 0.5)
    
14.                        (mapcar '+
    
15.                                (vlax-safearray->list ll)
    
16.                                (vlax-safearray->list ur))))
    
17.       (setq w        (cdr (assoc 42 mtext))
    
18.             h        (* 1.5 (cdr (assoc 43 mtext)))
    
19.             rot        (cdr (assoc 50 mtext))
    
20.             )
    
21.       (entmake
    
22.         (list
    
23.           '(0 . "line")
    
24.           '(62 . 1)
    
25.           (cons        10
    
26.                 (polar cp rot (* 0.6 w)))
    
27.           (cons        11
    
28.                 (polar cp rot (* -0.6 w)))
    
29.           )
    
30.         )
    
31.       (while (/= "" (setq str (getstring "\n输入文字:")))
    
32.         (if (not text)
    
33.           (progn
    
34.             (entmake mtext)
    
35.             (setq text (entlast))
    
36.             (vla-move
    
37.               (vlax-ename->vla-object text)
    
38.               (vlax-3d-point cp)
    
39.               (vlax-3d-point (polar cp (+ rot (* 0.5 pi)) h)))
    
40.             (setq text (entget text))
    
41.             )
    
42.           (progn
    
43.             (setq text (subst (cons 1 str) (assoc 1 text) text))
    
44.             (entmod text)
    
45.             )
    
46.           )
    
47.         )
    
48.     )
    
49.   (princ)
    
50.   )

(defun c:tt  (/ E MTEXT DIM DIMOBJ CP W H ROT STR TEXT)<br />   (while (and<br />         (setq e (nentsel "\n**选择标注文字:"))<br />         (setq mtext (car e))<br />         (= "MTEXT" (cdr (assoc 0 (setq mtext (entget mtext)))))<br />         )<br />       (setq text nil)<br />       (vla-GetBoundingBox<br />         (vlax-ename->vla-object (car e))<br />         'll<br />         'ur)<br />       (setq cp (mapcar '*<br />                        '(0.5 0.5 0.5)<br />                        (mapcar '+<br />                                (vlax-safearray->list ll)<br />                                (vlax-safearray->list ur))))<br />       (setq w        (cdr (assoc 42 mtext))<br />             h        (* 1.5 (cdr (assoc 43 mtext)))<br />             rot        (cdr (assoc 50 mtext))<br />             )<br />       (entmake<br />         (list<br />           '(0 . "line")<br />           '(62 . 1)<br />           (cons        10<br />                 (polar cp rot (* 0.6 w)))<br />           (cons        11<br />                 (polar cp rot (* -0.6 w)))<br />           )<br />         )<br />       (while (/= "" (setq str (getstring "\n输入文字:")))<br />         (if (not text)<br />           (progn<br />             (entmake mtext)<br />             (setq text (entlast))<br />             (vla-move<br />               (vlax-ename->vla-object text)<br />               (vlax-3d-point cp)<br />               (vlax-3d-point (polar cp (+ rot (* 0.5 pi)) h)))<br />             (setq text (entget text))<br />             )<br />           (progn<br />             (setq text (subst (cons 1 str) (assoc 1 text) text))<br />             (entmod text)<br />             )<br />           )<br />         )<br />     )<br />   (princ)<br />   )

yjr111

Gu_xl 发表于 2013-1-9 16:57

(progn
            (setq text (subst (cons 1 str) (assoc 1 text) text))
            (entmod text)
            )
这段去掉(progn )后能正确运行

zzmm

去掉  (progn)  不能正确运行
添加上面文字时  地一次  不管你输上面  在上面都会显示原有的标注尺寸

zzmm

      能正常运行的   忘记了  上面的那个  progn   的括号  没拉下来