[源码] 输出指定块的经纬度坐标
(defun WirteLog (text)
(setq filename "C:\\xxtool_log.txt") ; 设置文件路径和名称
(setq filehandler (open filename "a")) ; 打开文件并设置为追加模式
(write-line text filehandler)
(close filehandler)
)
(defun gs3xy2cs200022(x y) ;高斯3转cs2000(表为参数)
(setq l0 114.0)
(setq iPI 0.0174532925199433)
(setq a 6378137)
(setq f (/ 1 298.257222101))
(setq ZoneWide 3)
(setq ProjNo (/ x 1000000.000))
(setq ProjNo (fix (/ x 1000000)))
(setq l0 (* (ctl2go l0) iPI))
(setq X0 (+ (* ProjNo 1000000) 500000))
(setq Y0 0)
(setq xval (- x X0))
(setq yval (- y Y0))
(setq e2 (- (* 2 f) (* f f)))
(setq e1 (/ (- 1 (sqrt (- 1 e2))) (+ 1 (sqrt (- 1 e2)))))
(setq ee (/ e2 (- 1 e2)))
(setq m yval)
(setq u (/ m (* a (- 1 (/ e2 4) (/ (* 3 e2 e2) 64) (/ (* 5 e2 e2 e2) 256)))))
(setq fai (+ u (* (- (/ (* 3 e1) 2) (/ (* 27 e1 e1 e1) 32)) (Sin (* 2 u))) (* (- (/ (* 21 e1 e1) 16) (/ (* 55 e1 e1 e1 e1) 32)) (Sin (* 4 u))) (* (/ (* 151 e1 e1 e1) 96) (Sin (* 6 u))) (* (/ (* 1097 e1 e1 e1 e1) 512) (Sin (* 8 u)))))
(setq C (* ee (Cos fai) (Cos fai)))
(setq tt (* (tan fai) (tan fai)))
(setq NN (/ a (sqrt (- 1 (* e2 (Sin fai) (Sin fai))))))
(setq R (/ (* a (- 1 e2))(sqrt(* (- 1 (* e2 (Sin fai) (Sin fai))) (- 1 (* e2 (Sin fai) (Sin fai))) (- 1 (* e2 (Sin fai) (Sin fai)))))))
(setq D (/ xval NN))
(setq longitude1 (+ l0 (/ (+ (- D (/ (* (+ 1 (* 2 tt) C) D D D) 6)) (/ (* (+ (- 5 (* 2 C) (* 3 C C)) (* 28 tt) (* 8 ee) (* 24 tt tt)) D D D D D) 120)) (Cos fai))))
(setq latitude1 (- fai (* (/ (* NN (tan fai)) R) (+ (- (/ (* D D) 2) (/ (* (- (+ 5 (* 3 tt) (* 10 C)) (* 4 C C) (* 9 ee)) D D D D) 24)) (/ (* (- (+ 61 (* 90 tt) (* 298 C) (* 45 tt tt)) (* 256 ee) (* 3 C C)) D D D D D D) 720)))))
(setq latitude (/ latitude1 iPI))
(setq longitude (/ longitude1 iPI))
(list longitude latitude)
)
(defun findcoords()
(setq ss (ssget '((0 . "INSERT") (2 . "*水泥单杆*380V"))))
(if ss
(progn
(setq i 0)
(repeat (sslength ss)
(setq ent (ssname ss i))
(setq atts (entget ent))
(setq blkname (cdr (assoc 2 atts)))
(setq coords (cdr (assoc 10 atts)))
(setq cgcs2000 (gs3xy2cs200022 (car coords) (cadr coords)))
(setq name (cdr (assoc 2 atts)))
(WirteLog (strcat "块名称=" name ": " (rtos (car cgcs2000) 2 6) "," (rtos (cadr cgcs2000) 2 6) ""))
(setq i (1+ i))
)
)
)
)
(findcoords)
页:
[1]