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

ebigsong

最近开始学习lisp，感谢明经，给了很大的帮助，发点自己写的源码，主要就是引注，标注，然后生成组。就当做回馈明经的用户吧。高手就不要看了，见笑。

1. 
   
2. ;;;pn.lsp
   
3. ;;;根据选择的出户管，进行标注
   
4. ;;;输入：选择出户管，点取标注的点位，输入管道种类，编号
   
5. ;;;输出：出户管标注
   
6. ;;;最后编辑时间：2012.4.8
   
7. 
   
8. (defun *error* (msg)  exit)
   
9. (defun C:pn()
   
10. (setq r 500) ;设置标注圆直径
    
11. (setq pn_layer "W_DIM");设置标注图层
    
12.    (setq txt_style "hztxt");设置标注样式
    
13.    (setq g_yesorno 1);设置是否编组，0-不编组，1-编组
    
14.    (setq u_yesorno 0);设置是否将编号大写，0-否，1-大写
    
15. (setq txt_size (* r 0.6)) ;设置标注文字高度
    
16. (setq txt_off1 (/ r 8)) ;设置标注文字上移尺寸
    
17. (setq txt_off2 (/ r 4)) ;设置标注文字下移移动尺寸
    
18.   
    
19. (setvar"cmdecho"0)
    
20. (setq var_os (getvar "osmode"));记录捕捉
    
21. (setq var_old_layer (getvar "clayer"));记录当前图层
    
22. 
    
23. ;判断图层是否存在
    
24. (if (= nil (tblsearch "layer" pn_layer)) (command "layer" "m" pn_layer ""))
    
25. ;提示选择出户管，获得选择点
    
26. (setq inspt (osnap (cadr (entsel "\n选择出户管")) "nea"))
    
27. (while inspt
    
28.     (progn
    
29.      (setvar "clayer" pn_layer);设置当前图层
    
30.    (setvar "osmode" 0);取消捕捉
    
31.    
    
32.    ;插入出户标注圆
    
33.    (command "circle" inspt r)
    
34.    ;选择最后一个图元名
    
35.    (setq obj_c (entlast))
    
36.    ;移动出户标注图块pn_b.dwg
    
37.    (command "move" obj_c "" inspt pause)
    
38.    
    
39.    ;获取第二次输入的点
    
40.    (setq inspt1 (getvar 'lastpoint))
    
41.    ;绘制连接线
    
42.    (setq ang (*  (/ (angle inspt inspt1) pi) 180))
    
43.    (setq dis (- (distance inspt1 inspt) r))
    
44.    ;连接字符串
    
45.    (command "line" inspt (strcat "@" (rtos dis) "<" (rtos ang)) "")
    
46.    (setq obj_line (entlast))
    
47. 
    
48.    ;绘制圆的分隔线
    
49.    (command "line" inspt1 (strcat "@" (rtos (* r 2)) ",0") "")
    
50.    (setq obj_line2 (entlast))
    
51.    (command "move" obj_line2 "" inspt1 (strcat "@-" (rtos r) ",0"))
    
52.    
    
53.    ;提示输入出户管标志,自动转成大写
    
54.    (setq txt_name (getstring "\n出户管名称: "))
    
55.      (if (/= u_yesorno 0)
    
56.     (setq txt_name (strcase txt_name))
    
57.      )
    
58.    ;提示输入出户管编号
    
59.    (setq txt_no (getint "\n出户管编号: "))
    
60. 
    
61.    ;输入名称和编号
    
62.    (command "text" "J" "bc" inspt1 txt_size "0" txt_name)
    
63.    ;选择最后一个图元名
    
64.    (setq obj_na (entlast))
    
65.    (command "move" obj_na "" inspt1 (strcat "@0," (rtos txt_off1)))
    
66. 
    
67.    (command "text" "J" "tc" inspt1 txt_size "0" txt_no)
    
68.    ;选择最后一个图元名
    
69.    (setq obj_no (entlast))
    
70.    (command "move" obj_no "" inspt1 (strcat "@0,-" (rtos txt_off2)))
    
71. 
    
72.    (if (= g_yesorno 1) ;编组
    
73.       (progn
    
74.        (setq obj_together (ssadd obj_no (ssadd obj_na (ssadd obj_line2 (ssadd obj_c (ssadd obj_line))))))
    
75.        ;生成匿名组
    
76.        (command "-group" "c" "*" "出户管标注" obj_together "")
    
77.       )
    
78.      )
    
79.    
    
80.    (setvar "osmode" var_os);恢复捕捉
    
81.    (setvar "clayer" var_old_layer);恢复当前图层
    
82.    (princ)
    
83.    ;提示选择出户管，获得选择点
    
84.    (setq inspt (osnap (cadr (entsel "\n选择出户管")) "nea"))
    
85.    
    
86.   );end progn
    
87.    
    
88. );end while
    
89.   (princ)
    
90. )
    

<br /> ;;;pn.lsp<br /> ;;;根据选择的出户管，进行标注<br /> ;;;输入：选择出户管，点取标注的点位，输入管道种类，编号<br /> ;;;输出：出户管标注<br /> ;;;最后编辑时间：2012.4.8<br /> <br /> (defun *error* (msg)  exit)<br /> (defun C:pn()<br /> (setq r 500) ;设置标注圆直径<br /> (setq pn_layer "W_DIM");设置标注图层<br />    (setq txt_style "hztxt");设置标注样式<br />    (setq g_yesorno 1);设置是否编组，0-不编组，1-编组<br />    (setq u_yesorno 0);设置是否将编号大写，0-否，1-大写<br /> (setq txt_size (* r 0.6)) ;设置标注文字高度<br /> (setq txt_off1 (/ r 8)) ;设置标注文字上移尺寸<br /> (setq txt_off2 (/ r 4)) ;设置标注文字下移移动尺寸<br />   <br /> (setvar"cmdecho"0)<br /> (setq var_os (getvar "osmode"));记录捕捉<br /> (setq var_old_layer (getvar "clayer"));记录当前图层<br /> <br /> ;判断图层是否存在<br /> (if (= nil (tblsearch "layer" pn_layer)) (command "layer" "m" pn_layer ""))<br /> ;提示选择出户管，获得选择点<br /> (setq inspt (osnap (cadr (entsel "\n选择出户管")) "nea"))<br /> (while inspt<br />     (progn<br />      (setvar "clayer" pn_layer);设置当前图层<br />    (setvar "osmode" 0);取消捕捉<br />    <br />    ;插入出户标注圆<br />    (command "circle" inspt r)<br />    ;选择最后一个图元名<br />    (setq obj_c (entlast))<br />    ;移动出户标注图块pn_b.dwg<br />    (command "move" obj_c "" inspt pause)<br />     <br />    ;获取第二次输入的点<br />    (setq inspt1 (getvar 'lastpoint))<br />    ;绘制连接线<br />    (setq ang (*  (/ (angle inspt inspt1) pi) 180))<br />    (setq dis (- (distance inspt1 inspt) r))<br />    ;连接字符串<br />    (command "line" inspt (strcat "@" (rtos dis) "<" (rtos ang)) "")<br />    (setq obj_line (entlast))<br /> <br />    ;绘制圆的分隔线<br />    (command "line" inspt1 (strcat "@" (rtos (* r 2)) ",0") "")<br />    (setq obj_line2 (entlast))<br />    (command "move" obj_line2 "" inspt1 (strcat "@-" (rtos r) ",0"))<br />     <br />    ;提示输入出户管标志,自动转成大写<br />    (setq txt_name (getstring "\n出户管名称: "))<br />      (if (/= u_yesorno 0)<br />     (setq txt_name (strcase txt_name))<br />      )<br />    ;提示输入出户管编号<br />    (setq txt_no (getint "\n出户管编号: "))<br /> <br />    ;输入名称和编号<br />    (command "text" "J" "bc" inspt1 txt_size "0" txt_name)<br />    ;选择最后一个图元名<br />    (setq obj_na (entlast))<br />    (command "move" obj_na "" inspt1 (strcat "@0," (rtos txt_off1)))<br /> <br />    (command "text" "J" "tc" inspt1 txt_size "0" txt_no)<br />    ;选择最后一个图元名<br />    (setq obj_no (entlast))<br />    (command "move" obj_no "" inspt1 (strcat "@0,-" (rtos txt_off2)))<br /> <br />    (if (= g_yesorno 1) ;编组<br />       (progn<br />        (setq obj_together (ssadd obj_no (ssadd obj_na (ssadd obj_line2 (ssadd obj_c (ssadd obj_line))))))<br />        ;生成匿名组<br />        (command "-group" "c" "*" "出户管标注" obj_together "")<br />       )<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 />     <br />   );end progn<br />    <br /> );end while<br />   (princ)<br /> )<br />

1. 
   
2. ;;;pn1.lsp
   
3. ;;;为选择的对象添加带圈的编号
   
4. ;;;输入：选择对象，点取编号点，输入编号
   
5. ;;;输出：生成带圈的编号
   
6. ;;;2012.4.8
   
7. (defun *error* (msg)  exit)
   
8. (defun C:pn1()
   
9. (setq r 600) ;设置标注圆直径
   
10. (setq pn_layer "W_DIM");设置标注图层
    
11.    (setq txt_style "hztxt");设置标注样式
    
12.    (setq g_yesorno 1);设置是否编组
    
13. (setq txt_size (/ r 1.5)) ;设置标注文字高度
    
14.   
    
15. (setvar"cmdecho"0)
    
16. (setq var_os (getvar "osmode"));记录捕捉
    
17. (setq var_old_layer (getvar "clayer"));记录当前图层
    
18.   
    
19. ;判断图层是否存在
    
20. (if (= nil (tblsearch "layer" pn_layer)) (command "layer" "m" pn_layer ""))
    
21. ;提示选择出户管，获得选择点
    
22. (setq inspt (osnap (cadr (entsel "\n选择标注点")) "nea"))
    
23. (while inspt
    
24.     (progn
    
25.      (setvar "clayer" pn_layer);设置当前图层
    
26.    (setvar "osmode" 0);取消捕捉
    
27.    
    
28.    ;插入标注圆
    
29.    (command "circle" inspt r)
    
30.    ;选择最后一个图元名
    
31.    (setq obj_c (entlast))
    
32.    ;移动标注圆
    
33.    (command "move" obj_c "" inspt pause)
    
34.    ;获取第二次输入的点
    
35.    (setq inspt1 (getvar 'lastpoint))
    
36.    ;绘制连接线
    
37.    (setq ang (*  (/ (angle inspt inspt1) pi) 180))
    
38.    (setq dis (- (distance inspt1 inspt) r))
    
39.    ;连接字符串
    
40.    (command "line" inspt (strcat "@" (rtos dis) "<" (rtos ang)) "")
    
41.    (setq obj_line (entlast))
    
42.    ;提示输入编号
    
43.    (setq txt_name (getstring "\n编号: "))
    
44.    ;输入编号
    
45.    (command "text" "J" "mc" inspt1 txt_size "0" txt_name)
    
46.    ;选择最后一个图元名
    
47.    (setq obj_na (entlast))
    
48.    (if (= g_yesorno 1) ;编组
    
49.       (progn
    
50.        (setq obj_together (ssadd obj_na  (ssadd obj_c (ssadd obj_line))))
    
51.        ;生成匿名组
    
52.        (command "-group" "c" "*" "引注" obj_together "")
    
53.       )
    
54.      )
    
55.    (setvar "osmode" var_os);恢复捕捉
    
56.    (setvar "clayer" var_old_layer);恢复当前图层
    
57.    (princ)
    
58.    ;提示选择对象
    
59.    (setq inspt (osnap (cadr (entsel "\n选择标注点")) "nea"))
    
60.    
    
61.   );end progn
    
62.    
    
63. );end while
    
64. 
    
65. (princ)
    
66. )
    

<br /> ;;;pn1.lsp<br /> ;;;为选择的对象添加带圈的编号<br /> ;;;输入：选择对象，点取编号点，输入编号<br /> ;;;输出：生成带圈的编号<br /> ;;;2012.4.8<br /> (defun *error* (msg)  exit)<br /> (defun C:pn1()<br /> (setq r 600) ;设置标注圆直径<br /> (setq pn_layer "W_DIM");设置标注图层<br />    (setq txt_style "hztxt");设置标注样式<br />    (setq g_yesorno 1);设置是否编组<br /> (setq txt_size (/ r 1.5)) ;设置标注文字高度<br />   <br /> (setvar"cmdecho"0)<br /> (setq var_os (getvar "osmode"));记录捕捉<br /> (setq var_old_layer (getvar "clayer"));记录当前图层<br />   <br /> ;判断图层是否存在<br /> (if (= nil (tblsearch "layer" pn_layer)) (command "layer" "m" pn_layer ""))<br /> ;提示选择出户管，获得选择点<br /> (setq inspt (osnap (cadr (entsel "\n选择标注点")) "nea"))<br /> (while inspt<br />     (progn<br />      (setvar "clayer" pn_layer);设置当前图层<br />    (setvar "osmode" 0);取消捕捉<br />    <br />    ;插入标注圆<br />    (command "circle" inspt r)<br />    ;选择最后一个图元名<br />    (setq obj_c (entlast))<br />    ;移动标注圆<br />    (command "move" obj_c "" inspt pause)<br />    ;获取第二次输入的点<br />    (setq inspt1 (getvar 'lastpoint))<br />    ;绘制连接线<br />    (setq ang (*  (/ (angle inspt inspt1) pi) 180))<br />    (setq dis (- (distance inspt1 inspt) r))<br />    ;连接字符串<br />    (command "line" inspt (strcat "@" (rtos dis) "<" (rtos ang)) "")<br />    (setq obj_line (entlast))<br />    ;提示输入编号<br />    (setq txt_name (getstring "\n编号: "))<br />    ;输入编号<br />    (command "text" "J" "mc" inspt1 txt_size "0" txt_name)<br />    ;选择最后一个图元名<br />    (setq obj_na (entlast))<br />    (if (= g_yesorno 1) ;编组<br />       (progn<br />        (setq obj_together (ssadd obj_na  (ssadd obj_c (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 />     <br />   );end progn<br />    <br /> );end while<br /> <br /> (princ)<br /> )<br />

1. ;;;pn2.lsp
   
2. ;;;从选择的点引出带圈的编号
   
3. ;;;输入：选择引出点，选择标注点，输入编号
   
4. ;;;输出：从引出点带圈的编号
   
5. 
   
6. 
   
7. (defun *error* (msg)  exit)
   
8. (defun C:pn2()
   
9. 
   
10.   (setq r 600) ;设置标注圆直径
    
11.   (setq pn_layer "W_DIM");设置标注图层
    
12.     (setq txt_style "hztxt");设置标注样式
    
13.     (setq g_yesorno 1);设置是否编组
    
14. 
    
15.   (setq txt_size (/ r 1.5)) ;设置标注文字高度
    
16. 
    
17.   (setvar"cmdecho"0)
    
18. 
    
19.   (setq var_os (getvar "osmode"));记录捕捉
    
20.   (setq var_old_layer (getvar "clayer"));记录当前图层
    
21.   
    
22. 
    
23.   ;判断图层是否存在
    
24.   (if (= nil (tblsearch "layer" pn_layer)) (command "layer" "m" pn_layer ""))
    
25. 
    
26.   ;提示选择出户管，获得选择点
    
27.   (setq inspt (getpoint "\n选择标注点"))
    
28. 
    
29.   (while inspt
    
30.       (progn
    
31.         (setvar "clayer" pn_layer);设置当前图层
    
32.       (setvar "osmode" 0);取消捕捉
    
33.       
    
34.       ;插入出户标注圆
    
35.       (command "circle" inspt r)
    
36.       ;选择最后一个图元名
    
37.       (setq obj_c (entlast))
    
38. 
    
39.       ;移动出户标注图块pn_b.dwg
    
40.       (command "move" obj_c "" inspt pause)
    
41. 
    
42.       ;获取第二次输入的点
    
43.       (setq inspt1 (getvar 'lastpoint))
    
44. 
    
45.       ;绘制连接线
    
46.       (setq ang (*  (/ (angle inspt inspt1) pi) 180))
    
47.       (setq dis (- (distance inspt1 inspt) r))
    
48. 
    
49.       ;连接字符串
    
50.       (command "line" inspt (strcat "@" (rtos dis) "<" (rtos ang)) "")
    
51.       (setq obj_line (entlast))
    
52. 
    
53.       ;提示输入编号
    
54.       (setq txt_name (getstring "\n编号: "))
    
55. 
    
56.       ;输入编号
    
57.       (command "text" "J" "mc" inspt1 txt_size "0" txt_name)
    
58.       ;选择最后一个图元名
    
59.       (setq obj_na (entlast))
    
60.    
    
61.       (if (= g_yesorno 1) ;编组
    
62.           (progn
    
63.             (setq obj_together (ssadd obj_na  (ssadd obj_c (ssadd obj_line))))
    
64. 
    
65.             ;生成匿名组
    
66.             (command "-group" "c" "*" "引注" obj_together "")
    
67.           )
    
68.         )
    
69. 
    
70.       (setvar "osmode" var_os);恢复捕捉
    
71.       (setvar "clayer" var_old_layer);恢复当前图层
    
72.       (princ)
    
73. 
    
74.       ;提示选择出户管，获得选择点
    
75.       (setq inspt (getpoint "\n选择标注点"))
    
76.       
    
77.     );end progn
    
78.    
    
79.   );end while
    
80. 
    
81.   (princ)
    
82. 
    
83. )

;;;pn2.lsp<br /> ;;;从选择的点引出带圈的编号<br /> ;;;输入：选择引出点，选择标注点，输入编号<br /> ;;;输出：从引出点带圈的编号<br /> <br /> <br /> (defun *error* (msg)  exit)<br /> (defun C:pn2()<br /> <br />   (setq r 600) ;设置标注圆直径<br />   (setq pn_layer "W_DIM");设置标注图层<br />     (setq txt_style "hztxt");设置标注样式<br />     (setq g_yesorno 1);设置是否编组<br /> <br />   (setq txt_size (/ r 1.5)) ;设置标注文字高度<br /> <br />   (setvar"cmdecho"0)<br /> <br />   (setq var_os (getvar "osmode"));记录捕捉<br />   (setq var_old_layer (getvar "clayer"));记录当前图层<br />   <br /> <br />   ;判断图层是否存在<br />   (if (= nil (tblsearch "layer" pn_layer)) (command "layer" "m" pn_layer ""))<br /> <br />   ;提示选择出户管，获得选择点<br />   (setq inspt (getpoint "\n选择标注点"))<br /> <br />   (while inspt<br />       (progn<br />         (setvar "clayer" pn_layer);设置当前图层<br />       (setvar "osmode" 0);取消捕捉<br />       <br />       ;插入出户标注圆<br />       (command "circle" inspt r)<br />       ;选择最后一个图元名<br />       (setq obj_c (entlast))<br /> <br />       ;移动出户标注图块pn_b.dwg<br />       (command "move" obj_c "" inspt pause)<br /> <br />       ;获取第二次输入的点<br />       (setq inspt1 (getvar 'lastpoint))<br /> <br />       ;绘制连接线<br />       (setq ang (*  (/ (angle inspt inspt1) pi) 180))<br />       (setq dis (- (distance inspt1 inspt) r))<br /> <br />       ;连接字符串<br />       (command "line" inspt (strcat "@" (rtos dis) "<" (rtos ang)) "")<br />       (setq obj_line (entlast))<br /> <br />       ;提示输入编号<br />       (setq txt_name (getstring "\n编号: "))<br /> <br />       ;输入编号<br />       (command "text" "J" "mc" inspt1 txt_size "0" txt_name)<br />       ;选择最后一个图元名<br />       (setq obj_na (entlast))<br />     <br />       (if (= g_yesorno 1) ;编组<br />           (progn<br />             (setq obj_together (ssadd obj_na  (ssadd obj_c (ssadd obj_line))))<br /> <br />             ;生成匿名组<br />             (command "-group" "c" "*" "引注" obj_together "")<br />           )<br />         )<br /> <br />       (setvar "osmode" var_os);恢复捕捉<br />       (setvar "clayer" var_old_layer);恢复当前图层<br />       (princ)<br /> <br />       ;提示选择出户管，获得选择点<br />       (setq inspt (getpoint "\n选择标注点"))<br />       <br />     );end progn<br />     <br />   );end while<br /> <br />   (princ)<br /> <br /> )

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

<br /> ;;;pn3.lsp<br /> ;;;给选择的对象添加文字标注<br /> ;;;输入：选择对象和标注的点位，输入标注文字<br /> ;;;输出：生成引线及标注文字。<br /> ;;;最后修改时间：2012.4.8<br /> ;(defun *error* (msg)  exit)<br /> (defun C:pn3()<br />   <br /> (setq r 50) <br /> (setq lg_layer "W_DIM");设置标注图层<br />    (setq txt_style "hztxt");立管标注样式<br />    (setq g_yesorno 1);设置是否编组，0-不编组，1-编组<br /> (setq txt_size (* r 6)) ;设置标注文字高度<br /> (setq txt_off1 (* r 1)) ;设置标注文字上移尺寸<br />    (setq txt_off2 (* r 2)) ;设置标注文字左右移尺寸<br />   <br /> (setvar"cmdecho"0)<br /> (setq var_os (getvar "osmode"));记录捕捉<br /> (setq var_old_layer (getvar "clayer"));记录当前图层<br /> <br /> ;判断图层是否存在<br /> (if (= nil (tblsearch "layer" lg_layer)) (command "layer" "m" lg_layer ""))<br />    ;提示选择对象，获得选择点<br /> (setq inspt (osnap (cadr (entsel "\n选择标注对象")) "nea"))<br /> <br /> (while inspt<br />     (progn<br />      (setvar "clayer" lg_layer);设置当前图层<br />      (setvar "osmode" 0);取消捕捉<br />     <br />      (setq inspt1 (getpoint inspt "\n点取标注位置"))<br /> <br />    ;绘制连接线<br />    (command "line" inspt inspt1 "")<br />    (setq obj_line (entlast))<br />      (setq txt (getstring "\n标注内容: "))<br />     <br />        <br />    (setq ang (*  (/ (angle inspt inspt1) pi) 180))<br />      (if (or (<= ang 90) (>= ang 270))<br />      (progn<br />        <br />      ;输入名称和编号<br />     (command "text" "J" "bl" inspt1 txt_size "0" txt)<br />     ;选择最后一个图元名<br />     (setq obj_txt (entlast))<br />     (command "move" obj_txt "" inspt1 (strcat "@" (rtos txt_off2) "," (rtos txt_off1)))<br />        <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 />      (progn <br />        <br />      ;输入名称和编号<br />     (command "text" "J" "br" inspt1 txt_size "0" txt)<br />     ;选择最后一个图元名<br />     (setq obj_txt (entlast))<br />     (command "move" obj_txt "" inspt1 (strcat "@-" (rtos txt_off2) "," (rtos txt_off1)))<br />        <br />         ;绘制标注底线<br />         (setq txtb (textbox (entget obj_txt)))<br />     ;得到文字长度<br />     (setq txt_l (- (caadr txtb) (caar txtb)))<br />         <br />     (command "line" inspt1 (strcat "@-" (rtos (+ txt_l (* txt_off2 2))) ",0") "")<br />     (setq obj_line2 (entlast))<br />        )<br />      <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 /> <br />   );end progn<br />    <br /> );end while<br />   (princ)<br /> )<br />

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 /> )

林小林子

很需要这类插件，对工作提供很大便利
非常感谢楼主的无私分享

zkq1212

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

fdb2007

感谢楼主分享，下载试用

smartstar

感谢分享，学习了。

totoro

蛮实用的标注程序~
感谢分享~

vlisp2012

多谢楼主分享这么好的程序！！！

vlisp2012

多谢楼主分享这么好的程序！！！

注册

给排水专业的福音

夜精灵

非常感谢提供源码

sfjlx

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

edoumxx

很需要这类插件，对工作提供很大便利
非常感谢楼主的无私分享