求完善下代码.(画线并自动标注功能) (源码来自73.)

香田里浪人

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

压缩一下

2. (defun c:tts (/ p q pt)
   
3. ;(setvar'osmode 16384)
   
4. (setvar "cmdecho" 0)
   
5. (setvar "dimzin" 0);;保留小数位数时如果位数不足可以补零
   
6. (setq TextHeight (getdist "\n请输入文字高度: "))
   
7. (while (setq p (getpoint "\n指定起点: "))
   
8.   (command "pline" "_non" p)
   
9.   (while (setq q (getpoint p "\n下一点: ")
   
10.                      pt (mapcar '(lambda (x) (/ x 2)) (mapcar '+ p q)))
    
11.    (command "_non" q)
    
12.    (entmake
    
13.     (list
    
14.      '(0 . "TEXT")
    
15.      (cons 10 pt)
    
16.      (cons 40 1)
    
17.      (cons 1 (rtos (distance p q) 2 2))
    
18.      (cons 50 (if (< (/ Pi 2) (angle p q) (* 1.5 pi)) (angle q p) (angle p q)))
    
19.      (cons 8 "标注")
    
20.      (cons 7 "BG_ST")
    
21.      (cons 62 3)                        
    
22.      (cons 72 1)
    
23.      (cons 73 1)
    
24.      (cons 40 TextHeight)
    
25.      (cons 41 0.7)
    
26.      (cons 11 pt)
    
27.     )
    
28.    )
    
29.    (setq p q)
    
30.   )
    
31.   (command "")
    
32. )
    
33.   ;(setvar 'osmode (- (getvar osmode) 16384))
    
34. (setvar "cmdecho" 1)
    
35. (princ)
    
36. )
    

(defun c:tts (/ p q pt)<br /> ;(setvar'osmode 16384)<br /> (setvar "cmdecho" 0)<br /> (setvar "dimzin" 0);;保留小数位数时如果位数不足可以补零<br /> (setq TextHeight (getdist "\n请输入文字高度: "))<br /> (while (setq p (getpoint "\n指定起点: "))<br />   (command "pline" "_non" p)<br />   (while (setq q (getpoint p "\n下一点: ")<br />                      pt (mapcar '(lambda (x) (/ x 2)) (mapcar '+ p q)))<br />    (command "_non" q)<br />    (entmake<br />     (list<br />      '(0 . "TEXT")<br />      (cons 10 pt)<br />      (cons 40 1)<br />      (cons 1 (rtos (distance p q) 2 2))<br />      (cons 50 (if (< (/ Pi 2) (angle p q) (* 1.5 pi)) (angle q p) (angle p q)))<br />      (cons 8 "标注")<br />      (cons 7 "BG_ST")<br />      (cons 62 3)                         <br />      (cons 72 1)<br />      (cons 73 1)<br />      (cons 40 TextHeight)<br />      (cons 41 0.7)<br />      (cons 11 pt)<br />     )<br />    )<br />    (setq p q)<br />   )<br />   (command "")<br /> )<br />   ;(setvar 'osmode (- (getvar osmode) 16384))<br /> (setvar "cmdecho" 1)<br /> (princ)<br /> )<br />

鱼与熊掌

ZZXXQQ 发表于 2014-6-4 09:14
压缩一下

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

ZJKUSO

CAD2006试了，没显示标注