;;根据鱼与熊掌君提供的程序,添加两点:1保留小数位数时如果位数不足可以补零2自定义字高
(defun c:tts (/ p q pt en obj)
;(setvar'osmode 16384)
(setvar"dimzin"0);;保留小数位数时如果位数不足可以补零
(setq TextHeight (getdist "\n请输入文字高度:"))
(setq os_bak(getvar 'cmdecho))
(setvar 'cmdecho 0)
(setq p (getpoint "\n指定起点"))
(while p
(if p
(progn
(command "pline" "_non" p)
(while (setq q (getpoint p "下一点")
pt (mapcar '(lambda (x) (* x 0.5)) (mapcar '+ p q))
)
(command "_non" q)
(entmake (list '(0 . "TEXT")
(cons 10 pt)
(cons 40 1)
(cons 1 (rtos (distance p q) 2 2))
(cons 50
(if (and (< (/ Pi 2) (angle p q))
(> (* 1.5 pi) (angle p q))
)
(angle q p)
(angle p q)
)
)
(cons 8 "标注")
(cons 7 "BG_ST")
(cons 62 3)
(cons 72 1)
(cons 73 1)
(cons 40 TextHeight)
(cons 41 0.7)
(cons 11 pt)
)
)
(setq p q)
)
(if (>(getvar 'CMDACTIVE) 0) (command ""))
(setq p (getpoint "\n指定起点"))
)
;(setvar 'osmode (- (getvar osmode) 16384))
)
)
(if (>(getvar 'CMDACTIVE) 0) (command ""))
(if os_bak(setvar 'cmdecho os_bak))
(princ)
)
压缩一下(defun c:tts (/ p q pt)
;(setvar'osmode 16384)
(setvar "cmdecho" 0)
(setvar "dimzin" 0);;保留小数位数时如果位数不足可以补零
(setq TextHeight (getdist "\n请输入文字高度: "))
(while (setq p (getpoint "\n指定起点: "))
(command "pline" "_non" p)
(while (setq q (getpoint p "\n下一点: ")
pt (mapcar '(lambda (x) (/ x 2)) (mapcar '+ p q)))
(command "_non" q)
(entmake
(list
'(0 . "TEXT")
(cons 10 pt)
(cons 40 1)
(cons 1 (rtos (distance p q) 2 2))
(cons 50 (if (< (/ Pi 2) (angle p q) (* 1.5 pi)) (angle q p) (angle p q)))
(cons 8 "标注")
(cons 7 "BG_ST")
(cons 62 3)
(cons 72 1)
(cons 73 1)
(cons 40 TextHeight)
(cons 41 0.7)
(cons 11 pt)
)
)
(setq p q)
)
(command "")
)
;(setvar 'osmode (- (getvar osmode) 16384))
(setvar "cmdecho" 1)
(princ)
)
ZZXXQQ 发表于 2014-6-4 09:14 static/image/common/back.gif
压缩一下
酷炫`~~~ d `````
CAD2006试了,没显示标注