免费视频|新人指南|投诉删帖|广告合作|地信网APP下载

查看: 18264|回复: 83
收起左侧

[软件] 经纬度坐标标注及导出

    [复制链接]

148

主题

4万

铜板

148

好友

资深会员

Rank: 18Rank: 18Rank: 18Rank: 18Rank: 18

积分
3917

灌水勋章荣誉会员勋章活跃勋章地信专家组VIP勋章贡献勋章成就学员勋章

QQ
发表于 2017-4-5 08:33 | 显示全部楼层 |阅读模式


经纬度坐标导出及标注.zip (2.55 KB, 下载次数: 1145)

4

主题

239

铜板

1

好友

技术员

Rank: 3Rank: 3

积分
92
发表于 2018-11-26 19:32 | 显示全部楼层
  1. ;坐标标注 wzg356 2014.9.12
  2. ;2015.11.21改版
  3. (defun c:bzb ( / newerr *olderror* EntmakeLWPL entmaketext n hzt mjd x2y pt0 p1 p2
  4.         xpt ypt l pt2 xqz yqz en0 ent0 en1 ent1 en2 ent2 en3 ent3 gr gr-model gr-value pt1)
  5.         ;自定义新的出错函数
  6.     (defun newerr (msg)
  7.             (command "_erase" en0 en1 en2 en3  "")
  8.             (command "_undo" "_e")
  9.             (mapcar 'eval sysvarlst);恢复变量设置
  10.             (if *olderror* (setq *error* *olderror*  *olderror* nil)) ;_ 恢复*error*函数
  11.             (if (not (member msg '(nil "函数被取消" ";错误:quit / exit abort")))
  12.                     (princ (strcat ";错误:" msg))
  13.                 )
  14.         )
  15. ;============
  16.         ;;创建多义线
  17. (defun EntmakeLWPL (vertices Lw / elist seg)
  18.   (setq elist
  19.      (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline")
  20.             (cons 90 (length vertices))
  21.             (cons 70 0)
  22.             (cons 38 (caddr (car vertices)))
  23.             (cons 40 Lw)
  24.             (cons 41 Lw)
  25.             (cons 43 Lw)
  26.      )
  27.   )
  28.   (foreach seg vertices (setq elist (append elist (list (cons 10 seg) (cons 42 0)))))
  29.   (entmake elist)
  30. )
  31. ;============
  32. (defun entmaketext (pt str textheigh)
  33.      (entmakex (list '(0 . "text") (cons 1 str) (cons 7 "MY_ST")(cons 10 pt)
  34.              (cons 40 textheigh)(cons 41 0.8)(cons 11 pt) (cons 72 0) (cons 73 2)))
  35. )
  36.         ;;系统设置
  37.         (command "undo" "be");;命令编组开始
  38.         (setq sysvarlst(mapcar (function (lambda (n) (list 'setvar n (getvar n))))
  39.             '( "osmode" "cmdecho"  "plinewid" "TEXTSIZE" "textstyle" "dimzin")));保存系统变量
  40.         (setq *olderror* *error*);保存出错函数
  41.         (setq  *error* newerr);设置自定义出错函数       
  42.         (setvar "cmdecho" 0);;;关闭命令响应
  43.         (setvar "OSMODE" 675);;;改变捕捉模式
  44.         (setvar "dimzin" 1);;;数字不消零
  45.        
  46.         (if (= (Tblsearch "style" "MY_ST") nil)
  47.                 (command "-style" "MY_ST" "宋体" 0 0.8 0 "n" "n");;;文字样式
  48.         )       
  49.     (setvar "textstyle" "MY_ST")

  50.     ;;初始数据
  51.     (if xyrecords
  52.             (mapcar 'set (list 'hzt 'mjd 'x2y 'xqz 'yqz)
  53.                     (list (atof (nth 0 xyrecords))
  54.                             (atoi (nth 1 xyrecords))
  55.                             (atoi (nth 2 xyrecords))
  56.                             (nth 3 xyrecords)
  57.                             (nth 4 xyrecords)
  58.                     )
  59.                 )
  60.                 (mapcar 'set (list 'hzt 'mjd 'x2y 'xqz 'yqz)
  61.                (list ( getvar "TEXTSIZE") 2 0 "x=" "y=")
  62.             )                       
  63.         )   
  64.        
  65.         ;开始标注
  66.         (princ (strcat "\n当前文字高度" (rtos hzt 2 2)(if (= x2y 1) ", x/y值互换" "")))
  67.         (setq pt0 nil)
  68.         (initget 1 "S  ")
  69.         (setq pt0 (getpoint "\n点取标注点位置【或设置参数(S)】:"))       
  70.         (cond                                               
  71.                         ((= (type pt0) 'list)                               
  72.                                 (setq p1 (polar pt0 (* pi -0.5) (* hzt  0.7)))
  73.                                 (setq p2 (polar pt0 (* pi  0.5) (* hzt  0.7)))
  74.                                 (setq xpt (rtos (cadr pt0) 2 mjd)
  75.                                           ypt (rtos (car pt0) 2 mjd))
  76.                                 (setq l (* 0.72 hzt (max (strlen xpt) (strlen ypt))));依据字高的横线长度
  77.                                 (setq pt2 (polar pt0 0 l))
  78.                                 (entmakex (list
  79.                                         '(0 . "line") (cons 10 (trans pt0 1 0)) (cons 11 (polar (trans pt0 1 0) 0 1.0))));引线
  80.                                 (setq en0 (entlast) ent0 (entget en0))
  81.                                 (entmakex (list '(0 . "line") (cons 10 (trans pt0 1 0)) (cons 11 (trans pt2 1 0))));引线横
  82.                                 (setq en1 (entlast)        ent1 (entget en1))
  83.                                 (if (= x2y 1)
  84.                                         (entmaketext (trans p2 1 0) (strcat xqz ypt) hzt)
  85.                                         (entmaketext (trans p2 1 0) (strcat xqz xpt) hzt)
  86.                                 )
  87.                                 (setq en2 (entlast) ent2 (entget en2))
  88.                                 (if (= x2y 1)
  89.                                         (entmaketext (trans p1 1 0) (strcat yqz xpt) hzt)
  90.                                         (entmaketext (trans p1 1 0) (strcat yqz ypt) hzt)
  91.                                 )
  92.                                 (setq en3 (entlast) ent3 (entget en3))
  93.                                 (setq gr 0 gr-model 0 gr-value 0 );;gr-model必须归零
  94.                                 (while (/= gr-model 3) ;鼠标左键
  95.                                         (setq gr (grread T 8)
  96.                                                   gr-model (car gr)
  97.                                                   gr-value (cadr gr));鼠标位置
  98.                                         (if        (and gr (=  gr-model 5));鼠标移动
  99.                                                 (progn
  100.                                                         (setq pt1 gr-value)
  101.                                                         (if(>= (car gr-value)(car pt0));如果文字点在坐标点右边
  102.                                                             (setq pt2 (polar pt1 0 l)
  103.                                                                       p1 (polar pt1 (* pi -0.5) (* hzt  0.7))
  104.                                                                       p2 (polar pt1 (* pi  0.5) (* hzt  0.7)))
  105.                                                                 (setq pt2 (polar pt1 0 (* -1.0 l))
  106.                                                                           p1 (polar pt2 (* pi -0.5) (* hzt  0.7))
  107.                                                                           p2 (polar pt2 (* pi  0.5) (* hzt  0.7)));文字点在坐标点左边
  108.                                                         )
  109.                                                         (setq  ent0 (subst (cons 11 (trans pt1 1 0)) (assoc 11 ent0) ent0);根据鼠标位置调整图元位置
  110.                                                                ent1 (subst (cons 10 (trans pt1 1 0)) (assoc 10 ent1) ent1)
  111.                                                                ent1 (subst (cons 11 (trans pt2 1 0)) (assoc 11 ent1) ent1)
  112.                                                                ent2 (subst (cons 11 (trans p2 1 0)) (assoc 11 ent2) ent2)
  113.                                                                ent3 (subst (cons 11 (trans p1 1 0)) (assoc 11 ent3) ent3))
  114.                                                         (entmod ent0)(entmod ent1);重生成图元
  115.                                                         (entmod ent2)(entmod ent3)
  116.                                                 )
  117.                                         )
  118.                                 )
  119.                                 (entdel en0)(entdel  en1);删除直线引线
  120.                                 (EntmakeLWPL (list (trans pt0 1 0) (trans pt1 1 0) (trans pt2 1 0)) 0.1);以多线段重画引线
  121.                                 (c:bzb)
  122.                         )
  123.                         ((= pt0 "S")
  124.                                 (setq xyrecords(set_bzbdate))               
  125.                                 (c:bzb)
  126.                         )
  127.                         ((= pt0 "") nil)
  128.                         (t (c:bzb))
  129.         )       
  130.         ;;恢复设置
  131.         (command "_undo" "_e");;活动编组结束
  132.         (mapcar 'eval sysvarlst);恢复变量设置
  133.         (setq *error* *olderror*);;恢复出错函数
  134.         (princ)  
  135. );defun

  136. ;以下为子函数
  137. (defun set_bzbdate ( / get_date tuoqiulst mjdlst dcl_id dd);通过对话框设置参数       
  138.         (defun get_date ()
  139.                 (mapcar '(lambda (x) (get_tile x))
  140.                 (list "bzzg" "mjd" "x2y" "xqz" "yqz"))
  141.         )
  142.         (setq mjdlst (list "0" "0.0" "0.00" "0.000"))
  143.         (setq dcl_id (load_dialog (make-bzbdcl)))
  144.         (new_dialog "bzbdcl" dcl_id)       
  145.         (start_list "mjd" 3) (mapcar 'add_list mjdlst)(end_list)
  146.         (if (= xyrecords nil)
  147.                 (setq xyrecords(list (rtos ( getvar "TEXTSIZE") 2 2) "2" "0" "x=" "y=")))
  148.    (mapcar '(lambda (x y) (set_tile x y))(list "bzzg" "mjd" "x2y" "xqz" "yqz")xyrecords)       
  149.         (action_tile "accept" "(if (not(member (type (read (get_tile "bzzg"))) (list 'INT 'REAL)))(alert "字高非数字!") (progn(setq xyrecords(get_date))(done_dialog 1)))")               
  150.         (setq dd (start_dialog))
  151.         (unload_dialog dcl_id)
  152.         (if (= dd 1)xyrecords)
  153.                        
  154. )


  155. (defun make-bzbdcl  ( / lst_str str file f)
  156.                 (setq lst_str '(
  157. "bzbdcl:dialog {"
  158. "    label = "标注坐标" ;"
  159. "    :boxed_column {"
  160. "        :edit_box {"
  161. "            edit_width = 10 ;"
  162. "            key = "xqz" ;"
  163. "            label = "x前缀" ;"
  164. "        }"
  165. "        :edit_box {"
  166. "            edit_width = 10 ;"
  167. "            key = "yqz" ;"
  168. "            label = "y前缀" ;"
  169. "        }"
  170. "        :edit_box {"
  171. "            edit_width = 10 ;"
  172. "            key = "bzzg" ;"
  173. "            label = "文字高度" ;"
  174. "        }"
  175. "        :popup_list {"
  176. "            edit_width = 9.2 ;"
  177. "            key = "mjd" ;"
  178. "            label = "精度  " ;"
  179. "        }"
  180. "    }"
  181. "    :boxed_column {"
  182. "        :toggle {"
  183. "            key = "x2y" ;"
  184. "            label = "x/y值互换(前缀不变)" ;"
  185. "        }"
  186. "    }"
  187. "    :spacer {}"
  188. "    ok_only;"
  189. "    :text {"
  190. "        label = "by1047048660" ;"
  191. "    }"
  192. "}"
  193.                     )
  194.     )
  195.     (setq file (vl-filename-mktemp "DclTemp.dcl"))
  196.     (setq f (open file "w"))
  197.     (foreach str lst_str
  198.         (princ "\n" f)
  199.         (princ str f)
  200.     )
  201.     (close f)
  202.     ;;返回
  203.     file
  204. )
  205. ;;;=================================================================*
  206. (princ)
复制代码

回复 支持 1 反对 0

使用道具 举报

0

主题

1495

铜板

5

好友

助理工程师

Rank: 5Rank: 5

积分
222
发表于 2017-4-5 09:22 | 显示全部楼层
,,,,,,
回复 支持 反对

使用道具 举报

2

主题

5097

铜板

1

好友

助理工程师

Rank: 5Rank: 5

积分
282
发表于 2017-4-5 09:27 | 显示全部楼层
一个铜板,只要好用就值。谢谢!
回复 支持 反对

使用道具 举报

0

主题

2702

铜板

17

好友

助理工程师

Rank: 5Rank: 5

积分
160
发表于 2017-4-5 09:34 | 显示全部楼层
!!!!111111
回复

使用道具 举报

5

主题

1万

铜板

87

好友

地信院士

Rank: 15Rank: 15Rank: 15Rank: 15Rank: 15

积分
2687
发表于 2017-4-5 10:11 | 显示全部楼层
好好学习             天天向上           
该会员没有填写今日想说内容.
回复 支持 反对

使用道具 举报

0

主题

219

铜板

0

好友

技术员

Rank: 3Rank: 3

积分
13
发表于 2017-4-5 10:25 | 显示全部楼层
一个铜板,只要好用就值。谢谢!
回复 支持 反对

使用道具 举报

2

主题

821

铜板

3

好友

助理工程师

Rank: 5Rank: 5

积分
103
发表于 2017-4-5 14:17 | 显示全部楼层
谢谢 分享!
回复

使用道具 举报

0

主题

5837

铜板

0

好友

工程师

Rank: 7Rank: 7Rank: 7

积分
476
发表于 2017-4-6 09:13 | 显示全部楼层
谢谢分享!
回复

使用道具 举报

9

主题

2650

铜板

10

好友

高级工程师

Rank: 9Rank: 9Rank: 9

积分
915
发表于 2017-4-6 17:30 | 显示全部楼层
是通过转换参数计算的椭球坐标吗?
回复 支持 反对

使用道具 举报

17

主题

2万

铜板

35

好友

地信院士

Rank: 15Rank: 15Rank: 15Rank: 15Rank: 15

积分
2952

爱心勋章地信元老灌水勋章荣誉会员勋章活跃勋章贡献勋章成就学员勋章

发表于 2017-4-7 08:15 | 显示全部楼层
亲爱的楼主你好:请问加载后,如何启动(触发)该插件呢?谢谢!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

在线客服
快速回复 返回顶部 返回列表