框选中《标注》文字 在文字中间画一条直线 然后输入新的标注并写在原有标注的上方
起始的标注运行LISP程序
框选中标注文字例：50
在框选中的标注文字中心画线
用户自行输入需要更改的文字 并写在旧文字的上方
循环 框选 画线 写文字
当不用更改的时候
按esc键退出
更改过后的图样
(defun c:tt(/ E MTEXT DIM DIMOBJ CP W H ROT STR TEXT)
(while (and
(setq e (nentsel "\n**选择标注文字:"))
(setq mtext (car e))
(= "MTEXT" (cdr (assoc 0 (setq mtext (entget mtext)))))
)
(setq text nil)
(vla-GetBoundingBox
(vlax-ename->vla-object (car e))
'll
'ur)
(setq cp (mapcar '*
'(0.5 0.5 0.5)
(mapcar '+
(vlax-safearray->list ll)
(vlax-safearray->list ur))))
(setq w (cdr (assoc 42 mtext))
h (* 1.5 (cdr (assoc 43 mtext)))
rot (cdr (assoc 50 mtext))
)
(entmake
(list
'(0 . "line")
'(62 . 1)
(cons 10
(polar cp rot (* 0.6 w)))
(cons 11
(polar cp rot (* -0.6 w)))
)
)
(while (/= "" (setq str (getstring "\n输入文字:")))
(if (not text)
(progn
(entmake mtext)
(setq text (entlast))
(vla-move
(vlax-ename->vla-object text)
(vlax-3d-point cp)
(vlax-3d-point (polar cp (+ rot (* 0.5 pi)) h)))
(setq text (entget text))
)
(progn
(setq text (subst (cons 1 str) (assoc 1 text) text))
(entmod text)
)
)
)
)
(princ)
) Gu_xl 发表于 2013-1-9 16:57 static/image/common/back.gif
(progn
(setq text (subst (cons 1 str) (assoc 1 text) text))
(entmod text)
)
这段去掉(progn )后能正确运行 去掉(progn)不能正确运行
添加上面文字时地一次不管你输上面在上面都会显示原有的标注尺寸 能正常运行的 忘记了上面的那个progn 的括号没拉下来
页:
[1]