标注系列【源码】，回馈明经

JHX948954875

感谢楼主分享

shcvip

text 改用 entmakex 之后
;绘制标注底线
  (setq txtb (textbox (entget obj_txt)))  
就出错。

2. (defun C:pn3()
   
3. (setq scale (getvar "dimscale"))  ;获得全局比例
   
4. ;;;(setq lg_layer "W_DIM");设置标注图层
   
5. ;;; (setq txt_style "hztxt");立管标注样式
   
6. (setq g_yesorno 1);设置是否编组，0-不编组，1-编组
   
7. ;;;(setq txt_size (* scale 6)) ;设置标注文字高度
   
8. (setq txt_off1 (* scale 1)) ;设置标注文字上移尺寸
   
9. (setq txt_off2 (* scale 2)) ;设置标注文字左右移尺寸
   
10. (setvar"cmdecho"0)
    
11. (setq var_os (getvar "osmode"));记录捕捉
    
12. (setq var_old_layer (getvar "clayer"));记录当前图层
    
13. ;判断图层是否存在
    
14. ;;;(if (= nil (tblsearch "layer" lg_layer)) (command "layer" "m" lg_layer ""))
    
15. ;提示选择对象，获得选择点
    
16. (setq inspt (osnap (cadr (entsel "\n选择标注对象")) "nea"))
    
17. (while inspt
    
18.   (progn
    
19. ;;; (setvar "clayer" lg_layer);设置当前图层
    
20. (setvar "osmode" 0);取消捕捉
    
21. (setq inspt1 (getpoint inspt "\n点取标注位置"))
    
22. ;绘制连接线
    
23. (command "line" inspt inspt1 "")
    
24. (setq obj_line (entlast))
    
25. (setq txt_name (getstring "\n标注内容: "))
    
26. (setq ang (*(/ (angle inspt inspt1) pi) 180))
    
27. (if (or (<= ang 90) (>= ang 270))
    
28. (progn
    
29. ;输入名称和编号
    
30. ;;;  (command "text" "J" "bl" inspt1 txt_size "0" txt_name)
    
31. (entmakeX (list '(0 . "MTEXT")
    
32.                                                 '(100 . "AcDbEntity")
    
33.                                                 '(100 . "AcDbMText")
    
34.                                                 '(70 . 0)
    
35.                                                 '(71 . 7) ;;左对齐-下对齐
    
36.                                                 '(72 . 1)
    
37.                                                 '(73 . 2)
    
38.                                                 (cons 40 (* scale 6))
    
39.                                                       (cons 1  txt_name)
    
40.                                                 (cons 10 inspt1)                 
    
41.                         )
    
42.                 )
    
43.   
    
44.   ;选择最后一个图元名
    
45.   (setq obj_txt (entlast))
    
46.   (command "move" obj_txt "" inspt1 (strcat "@" (rtos txt_off2) "," (rtos txt_off1)))
    
47.   ;绘制标注底线
    
48.   (setq txtb (textbox (entget obj_txt)))  ;;;#### 这个如何改？####################
    
49.   ;得到文字长度
    
50.   (setq txt_l (- (caadr txtb) (caar txtb)))
    
51.   (command "line" inspt1 (strcat "@" (rtos (+ txt_l (* txt_off2 2))) ",0") "")
    
52.   (setq obj_line2 (entlast))
    
53.    )
    
54. (progn
    
55. ;输入名称和编号
    
56. ;;;  (command "text" "J" "br" inspt1 txt_size "0" txt_name)
    
57.    (entmakeX (list '(0 . "MTEXT")
    
58.                                                 '(100 . "AcDbEntity")
    
59.                                                 '(100 . "AcDbMText")
    
60.                                                 '(70 . 0)
    
61.                                                 '(71 . 9) ; 右对齐-下对齐
    
62.                                                 '(72 . 1)
    
63.                                                 '(73 . 2)
    
64.                                                 (cons 40 (* scale 6))
    
65.                                                       (cons 1  txt_name)
    
66.                                                 (cons 10 inspt1)                 
    
67.                         )
    
68.                 )
    
69.   ;选择最后一个图元名
    
70.   (setq obj_txt (entlast))
    
71.   (command "move" obj_txt "" inspt1 (strcat "@-" (rtos txt_off2) "," (rtos txt_off1)))
    
72.   ;绘制标注底线
    
73.   (setq txtb (textbox (entget obj_txt)))  ;;;#### 这个如何改？####################
    
74.   ;得到文字长度
    
75.   (setq txt_l (- (caadr txtb) (caar txtb)))
    
76.   (command "line" inspt1 (strcat "@-" (rtos (+ txt_l (* txt_off2 2))) ",0") "")
    
77.   (setq obj_line2 (entlast))
    
78.    )
    
79. )
    
80. (if (= g_yesorno 1) ;编组
    
81.   (progn
    
82.    ;建立选择集
    
83.    (setq obj_together (ssadd obj_txt (ssadd obj_line2 (ssadd obj_line))))
    
84.    ;生成匿名组
    
85.    (command "-group" "c" "*" "对象标注" obj_together "")
    
86.   )
    
87. )
    
88. (setvar "osmode" var_os);恢复捕捉
    
89. (setvar "clayer" var_old_layer);恢复当前图层
    
90. (princ)
    
91. ;提示选择对象，获得选择点
    
92. (setq inspt (osnap (cadr (entsel "\n选择标注对象")) "nea"))
    
93. );end progn
    
94. );end while
    
95. (princ)
    
96. )

(defun C:pn3()<br /> (setq scale (getvar "dimscale"))  ;获得全局比例 <br /> ;;;(setq lg_layer "W_DIM");设置标注图层<br /> ;;; (setq txt_style "hztxt");立管标注样式<br /> (setq g_yesorno 1);设置是否编组，0-不编组，1-编组<br /> ;;;(setq txt_size (* scale 6)) ;设置标注文字高度<br /> (setq txt_off1 (* scale 1)) ;设置标注文字上移尺寸<br /> (setq txt_off2 (* scale 2)) ;设置标注文字左右移尺寸<br /> (setvar"cmdecho"0)<br /> (setq var_os (getvar "osmode"));记录捕捉<br /> (setq var_old_layer (getvar "clayer"));记录当前图层<br /> ;判断图层是否存在<br /> ;;;(if (= nil (tblsearch "layer" lg_layer)) (command "layer" "m" lg_layer ""))<br /> ;提示选择对象，获得选择点<br /> (setq inspt (osnap (cadr (entsel "\n选择标注对象")) "nea"))<br /> (while inspt<br />   (progn<br /> ;;; (setvar "clayer" lg_layer);设置当前图层<br /> (setvar "osmode" 0);取消捕捉<br /> (setq inspt1 (getpoint inspt "\n点取标注位置"))<br /> ;绘制连接线<br /> (command "line" inspt inspt1 "")<br /> (setq obj_line (entlast))<br /> (setq txt_name (getstring "\n标注内容: ")) <br /> (setq ang (*(/ (angle inspt inspt1) pi) 180))<br /> (if (or (<= ang 90) (>= ang 270))<br /> (progn <br /> ;输入名称和编号<br /> ;;;  (command "text" "J" "bl" inspt1 txt_size "0" txt_name)<br /> (entmakeX (list '(0 . "MTEXT") <br />                                                 '(100 . "AcDbEntity") <br />                                                 '(100 . "AcDbMText")<br />                                                 '(70 . 0)<br />                                                 '(71 . 7) ;;左对齐-下对齐<br />                                                 '(72 . 1)<br />                                                 '(73 . 2)<br />                                                 (cons 40 (* scale 6))<br />                                                       (cons 1  txt_name)<br />                                                 (cons 10 inspt1)                 <br />                         )<br />                 )<br />   <br />   ;选择最后一个图元名<br />   (setq obj_txt (entlast))<br />   (command "move" obj_txt "" inspt1 (strcat "@" (rtos txt_off2) "," (rtos txt_off1)))<br />   ;绘制标注底线<br />   (setq txtb (textbox (entget obj_txt)))  ;;;#### 这个如何改？####################<br />   ;得到文字长度<br />   (setq txt_l (- (caadr txtb) (caar txtb)))<br />   (command "line" inspt1 (strcat "@" (rtos (+ txt_l (* txt_off2 2))) ",0") "")<br />   (setq obj_line2 (entlast))<br />    ) <br /> (progn <br /> ;输入名称和编号<br /> ;;;  (command "text" "J" "br" inspt1 txt_size "0" txt_name)<br />    (entmakeX (list '(0 . "MTEXT") <br />                                                 '(100 . "AcDbEntity") <br />                                                 '(100 . "AcDbMText")<br />                                                 '(70 . 0)<br />                                                 '(71 . 9) ; 右对齐-下对齐<br />                                                 '(72 . 1)<br />                                                 '(73 . 2)<br />                                                 (cons 40 (* scale 6))<br />                                                       (cons 1  txt_name)<br />                                                 (cons 10 inspt1)                 <br />                         )<br />                 )<br />   ;选择最后一个图元名<br />   (setq obj_txt (entlast))<br />   (command "move" obj_txt "" inspt1 (strcat "@-" (rtos txt_off2) "," (rtos txt_off1)))<br />   ;绘制标注底线<br />   (setq txtb (textbox (entget obj_txt)))  ;;;#### 这个如何改？####################<br />   ;得到文字长度<br />   (setq txt_l (- (caadr txtb) (caar txtb)))<br />   (command "line" inspt1 (strcat "@-" (rtos (+ txt_l (* txt_off2 2))) ",0") "")<br />   (setq obj_line2 (entlast))<br />    )<br /> )<br /> (if (= g_yesorno 1) ;编组<br />   (progn<br />    ;建立选择集<br />    (setq obj_together (ssadd obj_txt (ssadd obj_line2 (ssadd obj_line))))<br />    ;生成匿名组<br />    (command "-group" "c" "*" "对象标注" obj_together "")<br />   )<br /> )<br /> (setvar "osmode" var_os);恢复捕捉<br /> (setvar "clayer" var_old_layer);恢复当前图层<br /> (princ)<br /> ;提示选择对象，获得选择点<br /> (setq inspt (osnap (cadr (entsel "\n选择标注对象")) "nea"))<br /> );end progn<br /> );end while<br /> (princ)<br /> )

wolaixuexi

非常感谢提供源码

JHX948954875

谢谢楼主分享

zkq1212

虽然不同行，还是有用，非常感谢提供源码

qq1254582201

给排水专业的吧，给同行点赞

tranney

感谢楼主分享{:301_978:}~！

guankuiwu

下载了学习一下！