[源码] 输出指定块的经纬度坐标

admin1

1. 
   
2. (defun WirteLog (text)
   
3.         (setq filename "C:\\xxtool_log.txt") ; 设置文件路径和名称
   
4.         (setq filehandler (open filename "a")) ; 打开文件并设置为追加模式
   
5.         (write-line text filehandler)
   
6.         (close filehandler)
   
7. )
   
8. 
   
9. 
   
10. 
    
11. (defun gs3xy2cs200022(x y) ;高斯3转cs2000(表为参数)
    
12.         (setq l0 114.0)
    
13.         (setq iPI 0.0174532925199433)
    
14.         (setq a 6378137)
    
15.         (setq f (/ 1 298.257222101))
    
16.         (setq ZoneWide 3)
    
17.         (setq ProjNo (/ x 1000000.000))
    
18.         (setq ProjNo (fix (/ x 1000000)))
    
19.         (setq l0 (* (ctl2go l0) iPI))
    
20.         (setq X0 (+ (* ProjNo 1000000) 500000))
    
21.         (setq Y0 0)
    
22.         (setq xval (- x X0))
    
23.         (setq yval (- y Y0))
    
24.         (setq e2 (- (* 2 f) (* f f)))
    
25.         (setq e1 (/ (- 1 (sqrt (- 1 e2))) (+ 1 (sqrt (- 1 e2)))))
    
26.         (setq ee (/ e2 (- 1 e2)))
    
27.         (setq m yval)
    
28.         (setq u (/ m (* a (- 1 (/ e2 4) (/ (* 3 e2 e2) 64) (/ (* 5 e2 e2 e2) 256)))))
    
29.         (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)))))
    
30.         (setq C (* ee (Cos fai) (Cos fai)))
    
31.         (setq tt (* (tan fai) (tan fai)))
    
32.         (setq NN (/ a (sqrt (- 1 (* e2 (Sin fai) (Sin fai))))))
    
33.         (setq R (/ (* a (- 1 e2))(sqrt(* (- 1 (* e2 (Sin fai) (Sin fai))) (- 1 (* e2 (Sin fai) (Sin fai))) (- 1 (* e2 (Sin fai) (Sin fai)))))))
    
34.         (setq D (/ xval NN))
    
35.         (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))))
    
36.         (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)))))
    
37.         (setq latitude (/ latitude1 iPI))
    
38.         (setq longitude (/ longitude1 iPI))
    
39.         (list longitude latitude)
    
40. )
    
41. 
    
42. (defun findcoords()
    
43.   (setq ss (ssget '((0 . "INSERT") (2 . "*水泥单杆*380V"))))
    
44.   (if ss
    
45.     (progn
    
46.       (setq i 0)
    
47.       (repeat (sslength ss)
    
48.         (setq ent (ssname ss i))
    
49.                                 (setq atts (entget ent))
    
50.         (setq blkname (cdr (assoc 2 atts)))
    
51.         (setq coords (cdr (assoc 10 atts)))
    
52.                                 (setq cgcs2000 (gs3xy2cs200022 (car coords) (cadr coords)))
    
53.         (setq name (cdr (assoc 2 atts)))
    
54.         (WirteLog (strcat "块名称=" name ": " (rtos (car cgcs2000) 2 6) "," (rtos (cadr cgcs2000) 2 6) ""))
    
55.         (setq i (1+ i))
    
56.       )
    
57.     )
    
58.   )
    
59. )
    
60. 
    
61. (findcoords)
    
62. 
    

复制代码