entmake创建标注，且自动修改标注文字大小

小万LISP

本示例为创建水平标注，且依据当长度太小时，自动修改标注文字的大小

1. (defun c:tt(/ a b )
   
2.   (setq
   
3.     a(getpoint"\n起点")
   
4.     b(getpoint"\n终点")
   
5.   )
   
6.   (DimnkX a b)
   
7. )
   
8. 
   
9. ;水平标注，起点、终点，图层=4制图_内空
   
10. (defun DimnkX(a b / h x )
    
11.   (setq
    
12.     h 20
    
13.     x(distance a b)
    
14.   )
    
15.   ;把点坐标从当前坐标系转换为世界坐标系
    
16.   (setq a (trans a 1 0) b (trans b 1 0) )
    
17.   (entmakex
    
18.     (list
    
19.       '(0 . "DIMENSION")
    
20.       '(100 . "AcDbEntity")
    
21.       '(8 . "4制图_内空")  ;图层
    
22.       '(100 . "AcDbDimension")
    
23.       (cons 10 (list(car a)(+(cadr a)h)))  ;标注线高度定义点坐标
    
24.       '(70 . 32)  ;垂直/水平标注为32
    
25.       '(1 . "")    ;文字替代内容，默认为空
    
26.       '(3 . "内空")  ;标注样式
    
27.       '(100 . "AcDbAlignedDimension")
    
28.       (cons 13 a)  ;标注起点坐标
    
29.       (cons 14 b) ;标注终点坐标
    
30.       '(100 . "AcDbRotatedDimension")
    
31.     )
    
32.   )
    
33.   (if (<= x 500)
    
34.     (vlax-put-property  
    
35.       (vlax-ename->vla-object(entlast))  
    
36.       'TextHeight
    
37.       (fix (* x 0.2))  
    
38.     )
    
39.   )
    
40. )

(defun c:tt(/ a b )<br />   (setq <br />     a(getpoint"\n起点")<br />     b(getpoint"\n终点")<br />   )<br />   (DimnkX a b)<br /> )<br /> <br /> ;水平标注，起点、终点，图层=4制图_内空<br /> (defun DimnkX(a b / h x )<br />   (setq <br />     h 20 <br />     x(distance a b)<br />   )<br />   ;把点坐标从当前坐标系转换为世界坐标系<br />   (setq a (trans a 1 0) b (trans b 1 0) ) <br />   (entmakex<br />     (list <br />       '(0 . "DIMENSION")<br />       '(100 . "AcDbEntity")<br />       '(8 . "4制图_内空")  ;图层<br />       '(100 . "AcDbDimension")<br />       (cons 10 (list(car a)(+(cadr a)h)))  ;标注线高度定义点坐标<br />       '(70 . 32)  ;垂直/水平标注为32<br />       '(1 . "")    ;文字替代内容，默认为空<br />       '(3 . "内空")  ;标注样式<br />       '(100 . "AcDbAlignedDimension")<br />       (cons 13 a)  ;标注起点坐标<br />       (cons 14 b) ;标注终点坐标<br />       '(100 . "AcDbRotatedDimension")<br />     ) <br />   )<br />   (if (<= x 500)<br />     (vlax-put-property  <br />       (vlax-ename->vla-object(entlast))  <br />       'TextHeight <br />       (fix (* x 0.2))  <br />     )<br />   )<br /> )

664571221

用不起来........

ketxu

Thanks for sharing