朴素实用的代码，半动态坐标标注，出错处理，另类、常规循环、grread示例

wzg356

坐标标注的工具很全、很强、很多，但有时使用觉得反而复杂化了，好的代码至今未见。
仿写了个，可以拿去根据自己的需要加工。主要是出错处理，另类、常规循环、grread的应用对菜鸟们很有用。
本人菜鸟一个，因工作需要今年才接触lsp,借用明经里大师们的示例，一句一句凑得 ，但个人觉得比较有难度的部分搞出了。
感谢明经

欢迎拍，但要拍出你的好东东a

2. ;坐标标注 wzg356 2014.9.12
   
3. ;
   
4. (defun c:bzb ( / newerr *olderror* n hzt pt0 p1 p2 xpt ypt l pt2
   
5.                en0 ent0 en1 ent1 en2 ent2 en3 ent3 gr gr-model gr-value pt1)
   
6.   ;自定义新的出错函数
   
7.     (defun newerr (msg)
   
8.       (mapcar 'eval sysvarlst);恢复变量设置
   
9.       (if *olderror* (setq *error* *olderror*  *olderror* nil)) ;_ 恢复*error*函数
   
10.       (if (not (member msg '(nil "函数被取消" ";错误:quit / exit abort")))
    
11.         (princ (strcat ";错误:" msg))
    
12.     )
    
13.   )
    
14.   ;;系统设置
    
15.   (command "undo" "be");;命令编组开始
    
16.   (setq sysvarlst(mapcar (function (lambda (n) (list 'setvar n (getvar n))))
    
17.       '( "osmode" "cmdecho" "OSNAPCOORD" "dimzin" "plinewid" "TEXTSIZE" "textstyle")));保存系统变量
    
18.   (setq *olderror* *error*);保存出错函数
    
19.   (setq  *error* newerr);设置自定义出错函数  
    
20.   (setvar "cmdecho" 0);;;关闭命令响应
    
21.   (setvar "OSNAPCOORD" 1);;;坐标数据优先级设为：键盘输入替代对象捕捉设置
    
22.   (setvar "OSMODE" 675);;;改变捕捉模式
    
23.   (setvar "dimzin" 0);;;不对主单位值作消零处理
    
24.   
    
25.   (if (= (Tblsearch "style" "MY_ST") nil)
    
26.     (command "-style" "MY_ST" "宋体" 0 0.8 0 "n" "n");;;文字样式，字高处要设为0，否则command "_.TEXT 要改
    
27.   )  
    
28.     (setvar "textstyle" "MY_ST")  ;当前文字样式
    
29.   
    
30.   ;开始标注
    
31.   (if bzthzt (setq hzt bzthzt)(setq hzt 2.5));bzthzt设为全局变量 记忆字高
    
32.   (princ (strcat "\n当前文字高度" (rtos hzt 2 2)))
    
33.   (initget "S  ")  ;带空格的关键字
    
34.     (setq pt0 (getpoint "\n点取标注点位置【或设置文字高度(S)】:"));这样可在不需设字高时直接进入标注
    
35.     (cond
    
36.       ((= pt0 "S")
    
37.         (if (setq bzthzt (getreal (strcat "\n输入文字高度<" (rtos hzt 2 2) ">:")))(setq hzt bzthzt))
    
38.         (setq pt0 nil)  ;不要这句会出现错误提示（不影响使用)，悟出来的  ,但搞不明白   
    
39.       (c:bzb);设置完后循环至取标注点，有递归的影子
    
40.     )
    
41.     ((= pt0 "") nil);右键、空格退出
    
42.     )      
    
43.   
    
44.   (while pt0            ;开始循环标注
    
45.     (setq p1 (polar pt0 (* pi -0.5) (* hzt  0.7)));文字位置
    
46.     (setq p2 (polar pt0 (* pi  0.5) (* hzt  0.7)));文字位置
    
47.     (setq xpt (rtos (cadr pt0) 2 3) ;文字内容
    
48.         ypt (rtos (car pt0) 2 3)
    
49.     )
    
50.     (setq l (* 0.72 hzt (max (strlen xpt) (strlen ypt))));依据字高的横线长度，可自己调整
    
51.     (setq pt2 (polar pt0 0 l));横线端点
    
52.     (setvar "osmode" 0)
    
53.     (command "_.LINE" pt0 pt0 "");斜引线
    
54.     (setq en0 (entlast) ent0 (entget en0));取得组码表
    
55.     (command "_.LINE" pt0 pt2 "");引线横
    
56.     (setq en1 (entlast)  ent1 (entget en1))
    
57.     (command "_.TEXT" "ML" p2 hzt 0 (strcat "x=" xpt));写标注文字
    
58.     (setq en2 (entlast) ent2 (entget en2))
    
59.     (command "_.TEXT" "ML" p1 hzt  0 (strcat "y=" ypt))
    
60.     (setq en3 (entlast) ent3 (entget en3))
    
61.     (setq gr 0 gr-model 0 gr-value 0 );;gr-model必须归零
    
62.     (while (/= gr-model 3) ;鼠标左键，确认标注位置，退出循环
    
63.       (setq gr (grread T 8)   
    
64.           gr-model (car gr)   
    
65.           gr-value (cadr gr);鼠标位置
    
66.       )      
    
67.       (if  (and gr (=  gr-model 5));鼠标移动
    
68.         (progn
    
69.           (setq pt1 gr-value)
    
70.           (if(>= (car gr-value)(car pt0));如果文字点在坐标点右边
    
71.               (setq pt2 (polar pt1 0 l)
    
72.                   p1 (polar pt1 (* pi -0.5) (* hzt  0.7))
    
73.                   p2 (polar pt1 (* pi  0.5) (* hzt  0.7)))
    
74.               (setq pt2 (polar pt1 0 (* -1.0 l))               
    
75.                   p1 (polar pt2 (* pi -0.5) (* hzt  0.7))
    
76.                   p2 (polar pt2 (* pi  0.5) (* hzt  0.7)));文字点在坐标点左边
    
77.           )
    
78.             (setq  ent0 (subst (cons 11 pt1) (assoc 11 ent0) ent0);根据鼠标位置调整图元组码表
    
79.                  ent1 (subst (cons 10 pt1) (assoc 10 ent1) ent1)
    
80.                  ent1 (subst (cons 11 pt2) (assoc 11 ent1) ent1)
    
81.                  ent2 (subst (cons 11 p2) (assoc 11 ent2) ent2)
    
82.                  ent3 (subst (cons 11 p1) (assoc 11 ent3) ent3))
    
83.           (entmod ent0);重生成更新图元，显示到鼠标 位置
    
84.           (entmod ent1)
    
85.           (entmod ent2)
    
86.           (entmod ent3)
    
87.         )
    
88.       )
    
89.     )
    
90.     (command "_erase" en0 en1 "" );删除直线引线
    
91.     (command "_.pline" pt0 "w" 0.1 0.1 pt1 pt2 "" );以多线段重画引线，以便之后编辑
    
92.     (setvar "OSMODE" 675);;;改变捕捉模式为下次循环作准备
    
93.     (setq pt0 (getpoint "\n点取下一个标注点: "))
    
94.   )
    
95.   ;;恢复设置
    
96.     (command "_undo" "_e");;活动编组结束
    
97.   (mapcar 'eval sysvarlst);恢复变量设置
    
98.   (setq *error* *olderror*);;恢复出错函数
    
99.     (princ)  
    
100. )
     

;坐标标注 wzg356 2014.9.12<br /> ;<br /> (defun c:bzb ( / newerr *olderror* n hzt pt0 p1 p2 xpt ypt l pt2 <br />                en0 ent0 en1 ent1 en2 ent2 en3 ent3 gr gr-model gr-value pt1)<br />   ;自定义新的出错函数<br />     (defun newerr (msg)<br />       (mapcar 'eval sysvarlst);恢复变量设置<br />       (if *olderror* (setq *error* *olderror*  *olderror* nil)) ;_ 恢复*error*函数<br />       (if (not (member msg '(nil "函数被取消" ";错误:quit / exit abort")))<br />         (princ (strcat ";错误:" msg))<br />     )<br />   )<br />   ;;系统设置<br />   (command "undo" "be");;命令编组开始<br />   (setq sysvarlst(mapcar (function (lambda (n) (list 'setvar n (getvar n))))<br />       '( "osmode" "cmdecho" "OSNAPCOORD" "dimzin" "plinewid" "TEXTSIZE" "textstyle")));保存系统变量<br />   (setq *olderror* *error*);保存出错函数<br />   (setq  *error* newerr);设置自定义出错函数  <br />   (setvar "cmdecho" 0);;;关闭命令响应<br />   (setvar "OSNAPCOORD" 1);;;坐标数据优先级设为：键盘输入替代对象捕捉设置<br />   (setvar "OSMODE" 675);;;改变捕捉模式<br />   (setvar "dimzin" 0);;;不对主单位值作消零处理<br />   <br />   (if (= (Tblsearch "style" "MY_ST") nil)<br />     (command "-style" "MY_ST" "宋体" 0 0.8 0 "n" "n");;;文字样式，字高处要设为0，否则command "_.TEXT 要改<br />   )  <br />     (setvar "textstyle" "MY_ST")  ;当前文字样式<br />   <br />   ;开始标注<br />   (if bzthzt (setq hzt bzthzt)(setq hzt 2.5));bzthzt设为全局变量 记忆字高<br />   (princ (strcat "\n当前文字高度" (rtos hzt 2 2)))<br />   (initget "S  ")  ;带空格的关键字<br />     (setq pt0 (getpoint "\n点取标注点位置【或设置文字高度(S)】:"));这样可在不需设字高时直接进入标注<br />     (cond<br />       ((= pt0 "S") <br />         (if (setq bzthzt (getreal (strcat "\n输入文字高度<" (rtos hzt 2 2) ">:")))(setq hzt bzthzt))<br />         (setq pt0 nil)  ;不要这句会出现错误提示（不影响使用)，悟出来的  ,但搞不明白    <br />       (c:bzb);设置完后循环至取标注点，有递归的影子<br />     )<br />     ((= pt0 "") nil);右键、空格退出<br />     )      <br />   <br />   (while pt0            ;开始循环标注<br />     (setq p1 (polar pt0 (* pi -0.5) (* hzt  0.7)));文字位置<br />     (setq p2 (polar pt0 (* pi  0.5) (* hzt  0.7)));文字位置 <br />     (setq xpt (rtos (cadr pt0) 2 3) ;文字内容 <br />         ypt (rtos (car pt0) 2 3)<br />     )<br />     (setq l (* 0.72 hzt (max (strlen xpt) (strlen ypt))));依据字高的横线长度，可自己调整<br />     (setq pt2 (polar pt0 0 l));横线端点 <br />     (setvar "osmode" 0)<br />     (command "_.LINE" pt0 pt0 "");斜引线<br />     (setq en0 (entlast) ent0 (entget en0));取得组码表<br />     (command "_.LINE" pt0 pt2 "");引线横<br />     (setq en1 (entlast)  ent1 (entget en1))<br />     (command "_.TEXT" "ML" p2 hzt 0 (strcat "x=" xpt));写标注文字<br />     (setq en2 (entlast) ent2 (entget en2))<br />     (command "_.TEXT" "ML" p1 hzt  0 (strcat "y=" ypt))<br />     (setq en3 (entlast) ent3 (entget en3))<br />     (setq gr 0 gr-model 0 gr-value 0 );;gr-model必须归零<br />     (while (/= gr-model 3) ;鼠标左键，确认标注位置，退出循环<br />       (setq gr (grread T 8)   <br />           gr-model (car gr)   <br />           gr-value (cadr gr);鼠标位置<br />       )      <br />       (if  (and gr (=  gr-model 5));鼠标移动<br />         (progn<br />           (setq pt1 gr-value)<br />           (if(>= (car gr-value)(car pt0));如果文字点在坐标点右边<br />               (setq pt2 (polar pt1 0 l)<br />                   p1 (polar pt1 (* pi -0.5) (* hzt  0.7))<br />                   p2 (polar pt1 (* pi  0.5) (* hzt  0.7)))<br />               (setq pt2 (polar pt1 0 (* -1.0 l))                <br />                   p1 (polar pt2 (* pi -0.5) (* hzt  0.7))<br />                   p2 (polar pt2 (* pi  0.5) (* hzt  0.7)));文字点在坐标点左边<br />           )<br />             (setq  ent0 (subst (cons 11 pt1) (assoc 11 ent0) ent0);根据鼠标位置调整图元组码表<br />                  ent1 (subst (cons 10 pt1) (assoc 10 ent1) ent1)<br />                  ent1 (subst (cons 11 pt2) (assoc 11 ent1) ent1)<br />                  ent2 (subst (cons 11 p2) (assoc 11 ent2) ent2)<br />                  ent3 (subst (cons 11 p1) (assoc 11 ent3) ent3))<br />           (entmod ent0);重生成更新图元，显示到鼠标 位置<br />           (entmod ent1)<br />           (entmod ent2)<br />           (entmod ent3)<br />         )<br />       )<br />     )<br />     (command "_erase" en0 en1 "" );删除直线引线<br />     (command "_.pline" pt0 "w" 0.1 0.1 pt1 pt2 "" );以多线段重画引线，以便之后编辑<br />     (setvar "OSMODE" 675);;;改变捕捉模式为下次循环作准备<br />     (setq pt0 (getpoint "\n点取下一个标注点: "))<br />   )<br />   ;;恢复设置<br />     (command "_undo" "_e");;活动编组结束<br />   (mapcar 'eval sysvarlst);恢复变量设置<br />   (setq *error* *olderror*);;恢复出错函数<br />     (princ)  <br /> )<br />

1. 
   

复制代码

syx2014

楼主的程序不错，希望你能解决我的问题,谢谢了

http://bbs.mjtd.com/thread-111391-1-1.html
如何实现使用快捷提取多段线转为3dr格式？

wzg356

板凳自己坐

wzg356

syx2014 发表于 2014-9-13 00:01
楼主的程序不错，希望你能解决我的问题,谢谢了

http://bbs.mjtd.com/thread-111391-1-1.html

还不太懂你的这个

wzg356

自己躺下，eee

dbqtju

学习者，收藏了。

dbqtju

读懂了，不知道啥时候自己能写出自己的

pannelchen

研究下，谢共享源码

qq1254582201

坐标标注很不错啊，以后会用到的赞个。

xujinhua

很不错啊,谢谢楼主