CAD坐标直接标注经纬度

zn1996 · 发表于 2020-8-26 07:35:33

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

根据CAD XY坐标系按墨卡托计算方法自动标注经纬度坐标：
直转经纬(Z)：根据当前标注位置XY计算经纬度，需要插入的卫星影像底图没有被移动过，移动过标注均为错误。
基参经纬(X)：当上述影像被移动过位置，根据提示选择一个点，输入实际经纬度，根据XY相对坐标位置，标注出其他位置的经纬度。
原始坐标(C)：即标注XY坐标，方便部分需要标注XY坐标的朋友
无需其它插件支持，便携，另外支持浩辰CAD

(defun c:jwbz (/ fontvalue i key linetf realpoint style_list temp_linelr
temp_linetf temp_point_1 temp_point_3 temp_point_4
temp_xy user_point_1 wgs wgs_point wgsorxy x_dot_len
X_VALUE xy y_dot_len Y_VALUE
)
(defun defun_default ()
(while 1
(if (= (type key) 'LIST)
(progn (setq user_point_1 key) (setq key nil))
(setq user_point_1 (getpoint "\n请选中需要标注位置:"))
)
(while (equal user_point_1 nil)
(setq user_point_1 (getpoint "\n请选中需要标注位置:"))
)
(writeatt user_point_1 (xy2wgs user_point_1) "WGS" linetf)
)
)
(defun defun_1 ()
(setq realpoint (getpoint "\n请选中参照点:"))
; 这里realpoint为用户选择?
; 牟握盏?
(setq wgs_point (wgs2xy (list (getreal "请输入参照点实际经度:")
(getreal "请输入参照点实际纬度:")
)
)
) ; 这里wgs_point为用户输入的经纬度对应
; 的墨卡托坐标
(while 1
(setq user_point_1 (getpoint "\n请选中需要标注位置:"))
(while (equal user_point_1 nil)
(setq user_point_1 (getpoint "\n请选中需要标注位置:"))
)
(setq
xy (xy2wgs (polar (polar user_point_1
0
(- (car wgs_point) (car realpoint))
)
(* pi 0.5)
(- (cadr wgs_point) (cadr realpoint))
)
)
) ; 根据差值取偏移后的值
(writeatt user_point_1 xy "WGS" linetf)
)
)
(defun defun_2 ()
(while 1
(setq user_point_1 (getpoint "\n请选中需要标注位置:"))
(while (equal user_point_1 nil)
(setq user_point_1 (getpoint "\n请选中需要标注位置:"))
)
(writeatt user_point_1 user_point_1 "XY" linetf)
)
) ; ----------------------------应用函?
; ?----------------------------------
; ------
(defun onmsg () ; 开启消息回显
(setvar "CMDECHO" 1)
(setvar "nomutt" 0)
)
(defun offmsg () ; 关闭消息回显
(setvar "CMDECHO" 0)
(setvar "nomutt" 1)
)
(defun writeatt (temp_point_1 temp_xy wgsorxy temp_linetf)
; 写入数据块
(setq
temp_point_3 (getpoint temp_point_1 "\n请选择坐标标注插入位置:")
)
(while (equal temp_point_3 nil)
(setq temp_point_3
(getpoint temp_point_1 "\n请选择坐标标注插入位置:")
)
)
(if (> 0 (- (car temp_point_1) (car temp_point_3)))
(setq temp_linelr 0)
(setq temp_linelr pi)
)
(setq temp_point_4 (polar temp_point_3 temp_linelr 20))
(offmsg)
(setq fontvalue "Standard") ; 先设置为标准
(setq style_list (tblsearch "style" "宋体"))
(if (not style_list)
(setq fontvalue "宋体")
(progn (setq i 0)
(while (nth i style_list)
(if (= (cdr (nth i style_list)) "宋体")
(setq fontvalue "宋体")
)
(setq i (1+ i))
)
)
)
(if (= wgsorxy "WGS")
(progn (setq X_VALUE "经度:")
(setq Y_VALUE "纬度:")
(setq x_dot_len 6)
(setq y_dot_len 6)
)
(progn (setq X_VALUE "X=")
(setq Y_VALUE "Y=")
(setq x_dot_len 4)
(setq y_dot_len 4)
(if (> (fix (car temp_xy)) 100000)
(setq x_dot_len (- x_dot_len 2))
)
(if (> (fix (cadr temp_xy)) 100000)
(setq y_dot_len (- y_dot_len 2))
)
)
)
(entmake
(list '(0 . "MTEXT")
'(100 . "AcDbEntity")
'(100 . "AcDbMText")
(cons 7 fontvalue)
(cons 1
(strcat X_VALUE
(rtos (car temp_xy) 2 x_dot_len)
"\n"
Y_VALUE
(rtos (cadr temp_xy) 2 y_dot_len)
)
)
(cons 71 5)
(cons 62 3)
(cons 40 1.9)
(cons 5 "242")
(cons 10 (polar temp_point_3 temp_linelr 10))
)
)
(if (= temp_linetf "Y")
(entmake (append (list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 62 3)
(cons 90 3)
(cons 10 temp_point_1)
(cons 10 temp_point_3)
(cons 10 temp_point_4)
)
)
)
)
(onmsg)
)
(defun wgs2xy (wgs) ; wgs84转墨卡托(表为参数)
(list (* (/ (car wgs) 180) 20037508.34)
(/ (* (/ (log (/ (sin (/ (* pi (+ (cadr wgs) 90)) 360))
(cos (/ (* pi (+ (cadr wgs) 90)) 360))
)
)
(/ pi 180)
)
20037508.34
)
180
)
)
)
(defun xy2wgs (xy) ; 墨卡托转wgs84(表为参数)
(list
(/ (* (car xy) 180) 20037508.34)
(*
(/ 180 pi)
(-
(* 2
(atan (exp (/ (* (/ (* (cadr xy) 180) 20037508.34) pi) 180))
)
)
(/ pi 2)
)
)
)
)
(setvar "dimzin" 0)
(setq linetf "Y")
(initget "Z X C W")
(princ "\n请选择标注方式:")
(setq key
(getpoint
"\n请选中需要标注位置或输入参数:[直转经纬(Z)/基参经纬(X)/原始坐标(C)]"
)
)
(cond ((not key) (defun_default))
((= key "Z") (defun_default))
((= key "X") (defun_1))
((= key "C") (defun_2))
) ; cond
(defun_default) ; 因为跳过了关键词,故执行默认的函数
(princ)
)

(defun c:jwbz (/ fontvalue i key linetf        realpoint style_list temp_linelr 
               temp_linetf temp_point_1        temp_point_3 temp_point_4 
               temp_xy user_point_1 wgs        wgs_point wgsorxy x_dot_len 
               X_VALUE xy y_dot_len Y_VALUE 
              ) 
  (defun defun_default () 
    (while 1 
      (if (= (type key) 'LIST) 
        (progn (setq user_point_1 key) (setq key nil)) 
        (setq user_point_1 (getpoint "\n请选中需要标注位置:")) 
      ) 
      (while (equal user_point_1 nil) 
        (setq user_point_1 (getpoint "\n请选中需要标注位置:")) 
      ) 
      (writeatt user_point_1 (xy2wgs user_point_1) "WGS" linetf) 
    ) 
  ) 
  (defun defun_1 () 
    (setq realpoint (getpoint "\n请选中参照点:")) 
                                        ; 这里realpoint为用户选择? 
                                        ; 牟握盏? 
    (setq wgs_point (wgs2xy (list (getreal "请输入参照点实际经度:") 
                                  (getreal "请输入参照点实际纬度:") 
                            ) 
                    ) 
    )                                        ; 这里wgs_point为用户输入的经纬度对应 
                                        ; 的墨卡托坐标 
    (while 1 
      (setq user_point_1 (getpoint "\n请选中需要标注位置:")) 
      (while (equal user_point_1 nil) 
        (setq user_point_1 (getpoint "\n请选中需要标注位置:")) 
      ) 
      (setq 
        xy (xy2wgs (polar (polar user_point_1 
                                 0 
                                 (- (car wgs_point) (car realpoint)) 
                          ) 
                          (* pi 0.5) 
                          (- (cadr wgs_point) (cadr realpoint)) 
                   ) 
           ) 
      )                                        ; 根据差值取偏移后的值 
      (writeatt user_point_1 xy "WGS" linetf) 
    ) 
  ) 
  (defun defun_2 () 
    (while 1 
      (setq user_point_1 (getpoint "\n请选中需要标注位置:")) 
      (while (equal user_point_1 nil) 
        (setq user_point_1 (getpoint "\n请选中需要标注位置:")) 
      ) 
      (writeatt user_point_1 user_point_1 "XY" linetf) 
    ) 
  )                                        ; ----------------------------应用函? 
                                        ; ?---------------------------------- 
                                        ; ------ 
  (defun onmsg ()                        ; 开启消息回显 
    (setvar "CMDECHO" 1) 
    (setvar "nomutt" 0) 
  ) 
  (defun offmsg        ()                        ; 关闭消息回显 
    (setvar "CMDECHO" 0) 
    (setvar "nomutt" 1) 
  ) 
  (defun writeatt (temp_point_1 temp_xy wgsorxy temp_linetf) 
                                        ; 写入数据块 
    (setq 
      temp_point_3 (getpoint temp_point_1 "\n请选择坐标标注插入位置:") 
    ) 
    (while (equal temp_point_3 nil) 
      (setq temp_point_3 
             (getpoint temp_point_1 "\n请选择坐标标注插入位置:") 
      ) 
    ) 
    (if        (> 0 (- (car temp_point_1) (car temp_point_3))) 
      (setq temp_linelr 0) 
      (setq temp_linelr pi) 
    ) 
    (setq temp_point_4 (polar temp_point_3 temp_linelr 20)) 
    (offmsg) 
    (setq fontvalue "Standard")                ; 先设置为标准 
    (setq style_list (tblsearch "style" "宋体")) 
    (if        (not style_list) 
      (setq fontvalue "宋体") 
      (progn (setq i 0) 
             (while (nth i style_list) 
               (if (= (cdr (nth i style_list)) "宋体") 
                 (setq fontvalue "宋体") 
               ) 
               (setq i (1+ i)) 
             ) 
      ) 
    ) 
    (if        (= wgsorxy "WGS") 
      (progn (setq X_VALUE "经度:") 
             (setq Y_VALUE "纬度:") 
             (setq x_dot_len 6) 
             (setq y_dot_len 6) 
      ) 
      (progn (setq X_VALUE "X=") 
             (setq Y_VALUE "Y=") 
             (setq x_dot_len 4) 
             (setq y_dot_len 4) 
             (if (> (fix (car temp_xy)) 100000) 
               (setq x_dot_len (- x_dot_len 2)) 
             ) 
             (if (> (fix (cadr temp_xy)) 100000) 
               (setq y_dot_len (- y_dot_len 2)) 
             ) 
      ) 
    ) 
    (entmake 
      (list '(0 . "MTEXT") 
            '(100 . "AcDbEntity") 
            '(100 . "AcDbMText") 
            (cons 7 fontvalue) 
            (cons 1 
                  (strcat X_VALUE 
                          (rtos (car temp_xy) 2 x_dot_len) 
                          "\n" 
                          Y_VALUE 
                          (rtos (cadr temp_xy) 2 y_dot_len) 
                  ) 
            ) 
            (cons 71 5) 
            (cons 62 3) 
            (cons 40 1.9) 
            (cons 5 "242") 
            (cons 10 (polar temp_point_3 temp_linelr 10)) 
      ) 
    ) 
    (if        (= temp_linetf "Y") 
      (entmake (append (list '(0 . "LWPOLYLINE") 
                             '(100 . "AcDbEntity") 
                             '(100 . "AcDbPolyline") 
                             (cons 62 3) 
                             (cons 90 3) 
                             (cons 10 temp_point_1) 
                             (cons 10 temp_point_3) 
                             (cons 10 temp_point_4) 
                       ) 
               ) 
      ) 
    ) 
    (onmsg) 
  ) 
  (defun wgs2xy        (wgs)                        ; wgs84转墨卡托(表为参数) 
    (list (* (/ (car wgs) 180) 20037508.34) 
          (/ (*        (/ (log        (/ (sin (/ (* pi (+ (cadr wgs) 90)) 360)) 
                           (cos (/ (* pi (+ (cadr wgs) 90)) 360)) 
                        ) 
                   ) 
                   (/ pi 180) 
                ) 
                20037508.34 
             ) 
             180 
          ) 
    ) 
  ) 
  (defun xy2wgs        (xy)                        ; 墨卡托转wgs84(表为参数) 
    (list 
      (/ (* (car xy) 180) 20037508.34) 
      (* 
        (/ 180 pi) 
        (- 
          (* 2 
             (atan (exp (/ (* (/ (* (cadr xy) 180) 20037508.34) pi) 180)) 
             ) 
          ) 
          (/ pi 2) 
        ) 
      ) 
    ) 
  ) 
  (setvar "dimzin" 0) 
  (setq linetf "Y") 
  (initget "Z X C W") 
  (princ "\n请选择标注方式:") 
  (setq        key 
         (getpoint 
           "\n请选中需要标注位置或输入参数:[直转经纬(Z)/基参经纬(X)/原始坐标(C)]" 
         ) 
  ) 
  (cond        ((not key) (defun_default)) 
        ((= key "Z") (defun_default)) 
        ((= key "X") (defun_1)) 
        ((= key "C") (defun_2)) 
  )                                        ; cond 
  (defun_default)                        ; 因为跳过了关键词,故执行默认的函数 
  (princ) 
)

aisong220 · 发表于 2020-8-27 00:01:23

kyky1002 · 发表于 2020-8-27 07:59:35

可惜了，不支持高斯投影

huangpc27 · 发表于 2020-8-27 08:06:36

好东西啊，支持支持

zn1996 · 发表于 2020-8-27 09:02:34

kyky1002 发表于 2020-8-27 07:59
可惜了，不支持高斯投影

高斯投影算法复杂了点，还得手动输入带号，后面会做

xk15c · 发表于 2020-8-27 09:21:27

有用有用，快收下

Lisphk · 发表于 2020-8-27 16:06:02

要是能直接读 geotiff 的数据就好了

zn1996 · 发表于 2020-8-27 18:43:38

Lisphk 发表于 2020-8-27 16:06
要是能直接读 geotiff 的数据就好了

你把影像导入进去就可以标注呀。

Lisphk · 发表于 2020-8-27 18:57:00

zn1996 发表于 2020-8-27 18:43
你把影像导入进去就可以标注呀。

我的意思是不用自己输入实际WGS坐标，而是程序直接根据点就从GEOTIFF图片里面，提取到WGS坐标
就和其他GIS软件一样

zn1996 · 发表于 2020-8-27 20:20:09

Lisphk 发表于 2020-8-27 18:57
我的意思是不用自己输入实际WGS坐标，而是程序直接根据点就从GEOTIFF图片里面，提取到WGS坐标
就和其他G ...

你这想法很好，实现起来比较困难，geotiff里的信息用lisp读取起来并不方便，每次标注还得去选中那个影像。而且很多tif文件并不包含geotiff信息。

Lisphk · 发表于 2020-8-27 21:00:59

zn1996 发表于 2020-8-27 20:20
你这想法很好，实现起来比较困难，geotiff里的信息用lisp读取起来并不方便，每次标注还得去选中那个影像 ...

探讨下，
实际坐标你是怎么知道的呢？不还是要对照着在线地图影像？
如果需要在线地图影像，那么就可以得到geotiff,

如果没有在线影像的环境，如果能根据GEOTIFF直接得到实际坐标，那肯定是最方便的。

marting · 发表于 2020-8-27 21:18:24

zn1996 发表于 2020-8-27 20:20
你这想法很好，实现起来比较困难，geotiff里的信息用lisp读取起来并不方便，每次标注还得去选中那个影像 ...

思路是去找 activex 对象，然后用 vlisp 的方法可以做，
抛个砖, 使用 WIA.Imagefile 对象，可以得到图片的GIS各种信息

(defun exifdata (file / idata)
;;/ err idata iprop imgObj )
(if (and (setq file (findfile file))
(setq imgObj (vlax-create-object "WIA.Imagefile"))
) ;_ end of and
(progn
(setq
err (vl-catch-all-apply
(function
(lambda nil
(vlax-invoke-method imgObj 'loadfile file)
(setq iprop (vlax-get-property imgObj 'properties))
(princ "\nProperties")
) ;_ end of lambda
) ;_ end of function
) ;_ end of vl-catch-all-apply
) ;_ end of setq
(if (null (vl-catch-all-error-p err))
(progn
;;(dumpall iprop)
(setq idata (getall iprop))
(princ "\nData")
;;(dumpall idata)
) ;_ end of progn
) ;_ end of if
;_ end of if
) ;_ end of progn
) ;_ end of if
iprop
) ;_ end of defun
(defun getall (collection / err x valuelist name prop)
(vlax-for x collection
(setq name (vl-catch-all-apply '(lambda nil (vlax-get-property x 'name))))
(setq prop (vl-catch-all-apply '(lambda nil (vlax-variant-value (vlax-get-property x 'value)))))
(if (and (null (vl-catch-all-error-p name)) (null (vl-catch-all-error-p prop)))
(setq valuelist (cons (cons name prop) valuelist))
) ;_ end of if
;;(vlax-dump-object x T)
;_ end of setq
) ;_ end of vlax-for
(if (listp valuelist)
;;(null (vl-catch-all-error-p err))
(reverse valuelist)
) ;_ end of if
;;; (foreach x (reverse valuelist)
;;; (princ (strcat "\n" (vl-princ-to-string x)))
;;; ) ;_ end of foreach
) ;_ end of defun

(defun exifdata (file / idata) 
  ;;/ err idata iprop imgObj ) 
  (if (and (setq file (findfile file)) 
           (setq imgObj (vlax-create-object "WIA.Imagefile")) 
      ) ;_ end of and 
    (progn 
      (setq 
        err (vl-catch-all-apply 
              (function 
                (lambda nil 
                  (vlax-invoke-method imgObj 'loadfile file) 
                  (setq iprop (vlax-get-property imgObj 'properties)) 
                  (princ "\nProperties") 
                ) ;_ end of lambda 
              ) ;_ end of function 
            ) ;_ end of vl-catch-all-apply 
      ) ;_ end of setq 
      (if (null (vl-catch-all-error-p err)) 
        (progn 
          ;;(dumpall iprop) 
          (setq idata (getall iprop)) 
          (princ "\nData") 
          ;;(dumpall idata) 
        ) ;_ end of progn 
      ) ;_ end of if 
 ;_ end of if 
    ) ;_ end of progn 
  ) ;_ end of if 
  iprop 
) ;_ end of defun 
 
(defun getall (collection / err x valuelist name prop) 
  (vlax-for x collection 
    (setq name (vl-catch-all-apply '(lambda nil (vlax-get-property x 'name)))) 
    (setq prop (vl-catch-all-apply '(lambda nil (vlax-variant-value (vlax-get-property x 'value))))) 
    (if (and (null (vl-catch-all-error-p name)) (null (vl-catch-all-error-p prop))) 
      (setq valuelist (cons (cons name prop) valuelist)) 
    ) ;_ end of if 
    ;;(vlax-dump-object x T) 
 ;_ end of setq 
  ) ;_ end of vlax-for 
  (if (listp valuelist) 
    ;;(null (vl-catch-all-error-p err)) 
    (reverse valuelist) 
  ) ;_ end of if 
;;;  (foreach x (reverse valuelist) 
;;;    (princ (strcat "\n" (vl-princ-to-string x))) 
;;;  ) ;_ end of foreach 
) ;_ end of defun

通过上面函数，去读一个GEOTIFF文件，然后看看能打印出什么信息

marting · 发表于 2020-8-27 22:30:41

zn1996 发表于 2020-8-27 20:20
你这想法很好，实现起来比较困难，geotiff里的信息用lisp读取起来并不方便，每次标注还得去选中那个影像 ...

(("ImageWidth" . 1645)
("ImageHeight" . 4096)
("BitsPerSample" . #<VLA-OBJECT IVector 00000215fc6b81c0>)
("Compression" . 7)
("PhotometricInterp" . 2)
("SamplesPerPixel" . 3)
("PlanarConfig" . 1)
("TileWidth" . 256)
("TileLength" . 256)
("TileOffset" . #<VLA-OBJECT IVector 00000215fc6b8a10>)
("TileByteCounts" . #<VLA-OBJECT IVector 00000215fc6b8af0>)
("SampleFormat" . #<VLA-OBJECT IVector 00000215fc6b8d20>)
("347" . #<VLA-OBJECT IVector 00000215fc6b8ee0>)
("33550" . #<VLA-OBJECT IVector 00000215fc6b8c40>)
("33922" . #<VLA-OBJECT IVector 00000215fc6b8460>)
("34735" . #<VLA-OBJECT IVector 00000215fc6b8e00>)
("34736" . #<VLA-OBJECT IVector 00000215fc6b8150>)
("34737" . "SIRGAS-ROU98|SIRGAS-ROU98 / UTM zone 22S|"))

具体的经纬度信息去遍历对象 IVector

marting · 发表于 2020-8-27 22:42:44

zn1996 发表于 2020-8-27 20:20
你这想法很好，实现起来比较困难，geotiff里的信息用lisp读取起来并不方便，每次标注还得去选中那个影像 ...

命令: (EXIFDATA "d:\\yyd.tif")

Properties
Data#<VLA-OBJECT IProperties 0000023493cb5e18>

命令: !idata
(("ImageWidth" . 21472) ("ImageHeight" . 5952) ("BitsPerSample" . #<VLA-OBJECT IVector 0000023493e8dd10>) ("Compression" . 1) ("PhotometricInterp" . 2) ("ImageDescription" . "BIGEMAP MapDownloader") ("SamplesPerPixel" . 3) ("PlanarConfig" . 1) ("SoftwareUsed" . "BIGEMAP") ("TileWidth" . 256) ("TileLength" . 256) ("TileOffset" . #<VLA-OBJECT IVector 0000023493e8e720>) ("TileByteCounts" . #<VLA-OBJECT IVector 0000023493e8ddf0>) ("SampleFormat" . #<VLA-OBJECT IVector 0000023493e8dca0>) ("Copyright" . "Copyright (c) 2020 BIGEMAP") ("33550" . #<VLA-OBJECT IVector 0000023493e8e330>) ("33922" . #<VLA-OBJECT IVector 0000023493e8de60>) ("34735" . #<VLA-OBJECT IVector 0000023493e8e3a0>) ("34736" . #<VLA-OBJECT IVector 0000023493e8e250>) ("34737" . "WGS 84|"))

zn1996 · 发表于 2020-8-27 23:10:20

marting 发表于 2020-8-27 22:42
命令: (EXIFDATA "d:\\yyd.tif")

Properties

感谢老哥，我来尝试下。

账号		自动登录	找回密码
密码			立即注册

[标注] CAD坐标直接标注经纬度

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。