香田里浪人 发表于 2014-6-3 17:45:03

;;根据鱼与熊掌君提供的程序,添加两点: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)
)

ZZXXQQ 发表于 2014-6-4 09:14:45

压缩一下(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)
)

鱼与熊掌 发表于 2014-6-4 10:12:50

ZZXXQQ 发表于 2014-6-4 09:14 static/image/common/back.gif
压缩一下

酷炫`~~~   d   `````

ZJKUSO 发表于 2022-5-19 09:09:42

CAD2006试了,没显示标注
页: 1 2 [3]
查看完整版本: 求完善下代码.(画线并自动标注功能) (源码来自73.)