利用大神函数经纬度展点，多段线到十进制经纬度

树櫴希德

利用大神函数经纬度展点，多段线到十进制经纬度
谷歌地图KML文件经纬度是十进制的 奥维也是
以下是KML文件样表  红色子可以改动
<?xml version="1.0" encoding="UTF-8"?>
<kml xmlns="http://www.opengis.net/kml/2.2" xmlns:gx="http://www.google.com/kml/ext/2.2" xmlns:kml="http://www.opengis.net/kml/2.2" xmlns:atom="http://www.w3.org/2005/Atom">
<Document>
        <name>CCCC巴中停车场.kml</name>
        <Style id="s_ylw-pushpin_hl21">
                <IconStyle>
                        <scale>1.3</scale>
                        <Icon>
                                <href></href>
                        </Icon>
                        <hotSpot x="20" y="2" xunits="pixels" yunits="pixels"/>
                </IconStyle>
                <LineStyle>
                        <color>ff0000ff</color>
                        <width>3</width>
                </LineStyle>
        </Style>
        <Style id="s_ylw-pushpin11">
                <IconStyle>
                        <scale>1.1</scale>
                        <Icon>
                                <href></href>
                        </Icon>
                        <hotSpot x="20" y="2" xunits="pixels" yunits="pixels"/>
                </IconStyle>
                <LineStyle>
                        <color>ff0000ff</color>
                        <width>3</width>
                </LineStyle>
        </Style>
        <StyleMap id="m_ylw-pushpin21">
                <Pair>
                        <key>normal</key>
                        <styleUrl>#s_ylw-pushpin11</styleUrl>
                </Pair>
                <Pair>
                        <key>highlight</key>
                        <styleUrl>#s_ylw-pushpin_hl21</styleUrl>
                </Pair>
        </StyleMap>
        <Placemark>
                <name>未命CCCCBB名路径</name>
                <styleUrl>#m_ylw-pushpin21</styleUrl>
                <LineString>
                        <tessellate>1</tessellate>
                        <coordinates>
                                113.235146862,22.957426436
113.235051235,22.957391803
113.235063160,22.957363577
113.235074058,22.957367525
113.235084711,22.957342288
113.235071549,22.957337522
                </coordinates>
                </LineString>
        </Placemark>
</Document>
</kml>

1. ;;;功能：投影换带
   
2. ;;作者:HUA
   
3. ;;;创建日期：2020-8-18
   
4. ;;;最后编辑日期:2020-8-20
   
5. ;;;
   
6. ;;;秒转度分秒 s->dd.mmss
   
7. (defun Second2Dms(second / sign degree miniute second  dms)
   
8.   (setq   sign (< second 0)
   
9.       second (/ (abs second) 3600.0)
   
10.       degree (fix second)
    
11.       second (* (- second degree) 60.0)
    
12.       miniute (fix second)
    
13.       second (* (- second miniute) 60.0)
    
14.       dms (+ degree (/ miniute 100.0) (/ second 10000.0))
    
15.   )
    
16.   (if sign (setq dms (- 0 dms)))
    
17.   dms
    
18. )
    
19. ;;;
    
20. ;;;角度转弧度 dd.mmss->rad
    
21. (defun Dms2Rad(dms / sign degree miniute second rad)
    
22.   (setq  sign  (<  dms 0)
    
23.          dms  (abs dms)
    
24.        degree (fix dms)
    
25.        dms (* (- dms degree) 100)
    
26.        miniute (fix dms)
    
27.        second (* (- dms miniute) 100)   
    
28.        rad (/ (* (+ degree (/ miniute 60.0) (/ second 3600.0)) PI) 180.0)
    
29.   )
    
30.   (if sign (setq rad  (- 0 rad)))
    
31.   rad
    
32. )
    
33. ;;;
    
34. ;;;弧度转角度 rad->dd.mmss
    
35. (defun Rad2Dms(rad / sign degree miniute second dms)
    
36.   (setq   sign (< rad 0)
    
37.           rad (abs rad)
    
38.       rad (/ (* rad 180.0) PI)
    
39.       degree (fix rad)
    
40.       rad (* (- rad degree) 60.0)
    
41.       miniute (fix rad)
    
42.       second (* (- rad miniute) 60.0)
    
43.       dms (+ degree (/ miniute 100.0) (/ second 10000.0))
    
44.   )
    
45.   (if sign (setq dms (- 0 dms)))
    
46.   dms
    
47. )
    
48. ;;;
    
49. ;;;十进制角度转弧度 dd->rad
    
50. (defun Degree2Rad(degree / sign rad)
    
51.   (setq  sign  (<  degree 0)
    
52.          degree   (abs degree )      
    
53.        rad (/ (* degree  PI) 180.0)
    
54.   )
    
55.   (if sign (setq rad  (- 0 rad)))
    
56.   rad
    
57. )
    
58. ;;;十进制角度转DD.MMSS
    
59. 
    
60. (DEFUN 10-DDMMSS ( A / B C D E )
    
61. (SETQ B (Rad2Dms (Degree2Rad A)) )
    
62. (setq c (fix b)) (setq d (fix(*(- b c) 100)))
    
63. (setq e (- (* 10000 b) (* c 10000)  (* d 100) ) )
    
64.   (strcat (rtos c 2 0) "度" (rtos d 2 0) "分"  (rtos e 2 6) "秒")
    
65.   )
    
66. 
    
67. ;;;弧度转十进制角度 rad->dd
    
68. (defun Rad2Degree(rad / sign degree)
    
69.   (setq  sign  (<  rad 0)
    
70.          rad (abs rad)
    
71.          degree (/ (* rad 180.0) PI)
    
72.   )
    
73.   (if sign (setq degree  (- 0 degree)))
    
74.   degree
    
75. )
    
76. ;;;
    
77. ;;;54坐标系参数
    
78. (defun PrjPoint_Krasovsky( / a f e2 e12 A1 A2 A3 A4 A5 A6 A7 tf )
    
79.   (setq  a 6378245.0
    
80.       f 298.3
    
81.       tf (/ (- f 1) f)
    
82.       e2  (- 1 (* tf tf))
    
83.       tf (/ f (- f 1))
    
84.       e12 (- (* tf tf) 1)
    
85.       A1 6367558.4968749800000000
    
86.       A2  -16036.4802694116000000
    
87.       A3  16.8280668841393000
    
88.       A4  -0.0219753089548841
    
89.       A5 0.0000311310026601
    
90.       A6 -0.0000000459827472
    
91.       A7 0.0000000000679857      
    
92.   )
    
93.   (list a f e2 e12 A1 A2 A3 A4 A5 A6 A7)  
    
94. )
    
95. ;;;
    
96. ;;;80坐标系参数
    
97. (defun PrjPoint_IUGG1975(/ a f e2 e12 A1 A2 A3 A4 A5 A6 A7 tf)
    
98.   (setq  a    6378140.0
    
99.       f    298.257
    
100.       tf (/ (- f 1) f)
     
101.       e2  (- 1 (* tf tf))
     
102.       tf (/ f (- f 1))
     
103.       e12 (- (* tf tf) 1)
     
104.       A1    6367452.1327884300000000
     
105.       A2    -16038.5282286966000000
     
106.       A3    16.8326464353061000
     
107.       A4    -0.0219844636486152
     
108.       A5    0.0000311484690908
     
109.       A6    -0.0000000460151868
     
110.       A7    0.0000000000680433      
     
111.   )
     
112.   (list a f e2 e12 A1 A2 A3 A4 A5 A6 A7)  
     
113. )
     
114. ;;;
     
115. ;;;2000坐标系参数
     
116. (defun PrjPoint_2000(/ a f e2 e12 A1 A2 A3 A4 A5 A6 A7 tf)
     
117.   (setq  a    6378137.0
     
118.       f    298.257222101
     
119.       tf (/ (- f 1) f)
     
120.       e2  (- 1 (* tf tf))
     
121.       tf (/ f (- f 1))
     
122.       e12 (- (* tf tf) 1)
     
123.       A1    6367449.1457710400000000
     
124.       A2    -16038.5087415914000000
     
125.       A3    16.8326134276660000
     
126.       A4    -0.0219844041401628
     
127.       A5    0.0000311483615430
     
128.       A6    -0.0000000460149936
     
129.       A7    0.0000000000680429      
     
130.   )
     
131.    (list a f e2 e12 A1 A2 A3 A4 A5 A6 A7)  
     
132. )
     
133. ;;;
     
134. ;;;BL转cadx,cady
     
135. ;;;输入参数
     
136. ;;;B,L为点位纬度和经度，单位为弧度
     
137. ;;;L0为中央经线，单位为弧度
     
138. ;;;prjType取值为0:北京54坐标系,1:西安80坐标系，2：CGCS2000坐标系
     
139. ;;;输出CAD坐标x,y
     
140. (defun PrjPoint:BL2xy(B L L0 prjType / a f e2 e12 A1 A2 A3 A4 A5 A6 A7 X N tanB tanB2 m m2 ng2 sinB cosB cadx cady)   
     
141.     (cond
     
142.     ((= 0 prjType) (mapcar 'set (list 'a 'f 'e2 'e12 'A1 'A2 'A3 'A4 'A5 'A6 'A7) (PrjPoint_Krasovsky)))
     
143.     ((= 1 prjType) (mapcar 'set (list 'a 'f 'e2 'e12 'A1 'A2 'A3 'A4 'A5 'A6 'A7) (PrjPoint_IUGG1975)))
     
144.     ((= 2 prjType) (mapcar 'set (list 'a 'f 'e2 'e12 'A1 'A2 'A3 'A4 'A5 'A6 'A7) (PrjPoint_2000)))
     
145.     (T (alert "未知prjType参数值")(exit))
     
146.   )
     
147.   (setq  X       (+ (* A1 B) (* A2 (sin (* 2 B))) (*  A3 (sin (* 4 B))) (* A4 (sin (* 6 B))) (* A5  (sin (* 8 B))) (* A6 (sin (* 10 B))) (* A7 (sin (* 12 B))))
     
148.       sinB   (sin B)  cosB   (cos B) tanB   (/ (sin B) (cos B))   tanB2   (* tanB tanB)
     
149.       N      (/ a (sqrt (- 1 (* e2 sinB sinB))))
     
150.       m      (* cosB (- L L0))  m2 (* m m)
     
151.       ng2      (/ (* cosB cosB e2) (- 1 e2))
     
152.       cady    (+ X (* N tanB (* (+ 0.5 (* (+ (/ (+ (- 5 tanB2) (* 9 ng2) (* 4 ng2 ng2)) 24.0) (/ (* (+ (- 61 (* 58 tanB2)) (* tanB2 tanB2)) m2) 72.0)) m2)) m2)))
     
153.       cadx    (+ 500000 (* N m  (+ 1 (* m2 (+ (/ (+ (- 1 tanB2) ng2) 6.0) (/ (* m2 (-  (+ 5 (* tanB2 tanB2) (* 14 ng2)) (* 18 tanB2) (* 58 ng2 tanB2))) 120.0))))))   
     
154.   )
     
155.   (list cadx cady)  
     
156. )
     
157. ;;;
     
158. ;;;cadx,cady转BL
     
159. ;;;输入参数
     
160. ;;;;pt为点位cad点坐标,
     
161. ;;;L0为中央经线，单位为弧度
     
162. ;;;prjType取值为0:北京54坐标系,1:西安80坐标系，2：CGCS2000坐标系
     
163. ;;;输出经纬度B,L表，单位为dd.mmss
     
164. (defun PrjPoint:xy2BL(pt L0 prjType / a f e2 e12 A1 A2 A3 A4 A5 A6 A7 sinB cosB tanB tanB2 N ng2 V yN preB0 B0 eta x y )
     
165.   (cond
     
166.     ((= 0 prjType) (mapcar 'set (list 'a 'f 'e2 'e12 'A1 'A2 'A3 'A4 'A5 'A6 'A7) (PrjPoint_Krasovsky)))
     
167.     ((= 1 prjType) (mapcar 'set (list 'a 'f 'e2 'e12 'A1 'A2 'A3 'A4 'A5 'A6 'A7) (PrjPoint_IUGG1975)))
     
168.     ((= 2 prjType) (mapcar 'set (list 'a 'f 'e2 'e12 'A1 'A2 'A3 'A4 'A5 'A6 'A7) (PrjPoint_2000)))
     
169.     (T (alert "未知prjType参数值")(exit))
     
170.   )
     
171.   (setq   x    (cadr pt)
     
172.       y    (- (car pt) 500000)
     
173.       B0   (/ x A1)
     
174.       eta  1
     
175.   )  
     
176.   (while (> eta  0.000000000048)
     
177.     (setq  preB0  B0
     
178.         B0   (/ (- x (+ (* A2 (sin (* 2 B0))) (* A3 (sin (* 4 B0))) (* A4 (sin (* 6 B0))) (* A5 (sin (* 8 B0))) (* A6 (sin (* 10 B0))) (* A7 (sin (* 12 B0))))) A1)
     
179.         eta (abs (- B0 preB0))
     
180.     )  
     
181.   )  
     
182.   (setq   sinB  (sin B0)
     
183.       cosB   (cos B0)
     
184.       tanB    (/ (sin B0) (cos B0))
     
185.       tanB2   (* tanB tanB)
     
186.       N      (/ a (sqrt (- 1 (* e2 sinB sinB))))
     
187.       ng2      (/ (* cosB cosB e2) (- 1 e2))
     
188.       V    (sqrt (+ 1 ng2))
     
189.       yN    (/ y N)   
     
190.       B    (- B0 (* (+ (- (* yN yN) (/ (* (- (+ 5 (* 3 tanB2) ng2) (* 9 ng2 tanB2)) yN yN yN yN) 12.0)) (/ (* (+ 61 (* 90 tanB2) (* 45 tanB2 tanB2)) yN yN yN yN yN yN) 360.0)) V V tanB 0.5))      
     
191.       L    (+ L0 (/ (+ (- yN (/ (* (+ 1 (* 2 tanB2) ng2) yN yN yN) 6.0 )) (/ (* (+ 5 (* 28 tanB2) (* 24 tanB2 tanB2) (* 6 ng2) (* 8 ng2 tanB2)) yN yN yN yN yN) 120.0)) cosB))   
     
192.   )
     
193.   (list (Rad2Dms B) (Rad2Dms L))
     
194. )
     
195. ;;;
     
196. ;;;cadx,cady转BL
     
197. ;;;输入参数
     
198. ;;;;pt为点位cad点坐标,
     
199. ;;;L0为中央经线，单位为弧度
     
200. ;;;prjType取值为0:北京54坐标系,1:西安80坐标系，2：CGCS2000坐标系
     
201. ;;;输出经纬度B,L表，单位为十进制
     
202. (defun PrjPoint:xy2BL2(pt L0 prjType / a f e2 e12 A1 A2 A3 A4 A5 A6 A7 sinB cosB tanB tanB2 N ng2 V yN preB0 B0 eta x y )
     
203.   (cond
     
204.     ((= 0 prjType) (mapcar 'set (list 'a 'f 'e2 'e12 'A1 'A2 'A3 'A4 'A5 'A6 'A7) (PrjPoint_Krasovsky)))
     
205.     ((= 1 prjType) (mapcar 'set (list 'a 'f 'e2 'e12 'A1 'A2 'A3 'A4 'A5 'A6 'A7) (PrjPoint_IUGG1975)))
     
206.     ((= 2 prjType) (mapcar 'set (list 'a 'f 'e2 'e12 'A1 'A2 'A3 'A4 'A5 'A6 'A7) (PrjPoint_2000)))
     
207.     (T (alert "未知prjType参数值")(exit))
     
208.   )
     
209.   (setq   x    (cadr pt)
     
210.       y    (- (car pt) 500000)
     
211.       B0   (/ x A1)
     
212.       eta  1
     
213.   )  
     
214.   (while (> eta  0.000000000048)
     
215.     (setq  preB0  B0
     
216.         B0   (/ (- x (+ (* A2 (sin (* 2 B0))) (* A3 (sin (* 4 B0))) (* A4 (sin (* 6 B0))) (* A5 (sin (* 8 B0))) (* A6 (sin (* 10 B0))) (* A7 (sin (* 12 B0))))) A1)
     
217.         eta (abs (- B0 preB0))
     
218.     )  
     
219.   )  
     
220.   (setq   sinB  (sin B0)
     
221.       cosB   (cos B0)
     
222.       tanB    (/ (sin B0) (cos B0))
     
223.       tanB2   (* tanB tanB)
     
224.       N      (/ a (sqrt (- 1 (* e2 sinB sinB))))
     
225.       ng2      (/ (* cosB cosB e2) (- 1 e2))
     
226.       V    (sqrt (+ 1 ng2))
     
227.       yN    (/ y N)   
     
228.       B    (- B0 (* (+ (- (* yN yN) (/ (* (- (+ 5 (* 3 tanB2) ng2) (* 9 ng2 tanB2)) yN yN yN yN) 12.0)) (/ (* (+ 61 (* 90 tanB2) (* 45 tanB2 tanB2)) yN yN yN yN yN yN) 360.0)) V V tanB 0.5))      
     
229.       L    (+ L0 (/ (+ (- yN (/ (* (+ 1 (* 2 tanB2) ng2) yN yN yN) 6.0 )) (/ (* (+ 5 (* 28 tanB2) (* 24 tanB2 tanB2) (* 6 ng2) (* 8 ng2 tanB2)) yN yN yN yN yN) 120.0)) cosB))   
     
230.   )
     
231.   (list (Rad2Degree L) (Rad2Degree B) )
     
232. )
     
233. 
     
234. ;;;;;;;;;;;;;;;;;;;;;;;;;;;
     
235. 
     
236. 
     
237. (defun c:jw-2000 (   / l0 bb ll vvv str  )
     
238. 
     
239. (setq l0 (getreal "\n请输入中央子午线经度dd.mmss:"))
     
240. (setq bb (getreal "\n请输入待求点纬度dd.mmss:"))
     
241. (setq ll (getreal "\n请输入待求点经度dd.mmss:"))
     
242. 
     
243. (setq vvv(append(PrjPoint:BL2xy (dms2rad bb) (dms2rad ll) (dms2rad l0)2)'(0)))
     
244. (setq str(strcat (rtos bb 2 12 )","(rtos ll 2 12 )))
     
245. (entmake (list '(0 . "TEXT")'(8 . "jwd") (cons 1 str) (cons 10 vvv) (cons 40 2)))
     
246. (entmake (list '(0 . "POINT")'(8 . "jwd") (cons 10 vvv)))
     
247.   
     
248.   )
     
249. 
     
250. (defun vxs(e / p a b n ob q et d d1 en et)
     
251.     (setq a(entget e)ob(vlax-ename->vla-object e)et(cdr(assoc 0 a))n 0 p nil d nil)
     
252.     (cond((="LWPOLYLINE"et)
     
253.     (repeat(length a)(setq b (nth n a) n (+ n 1))
     
254.       (if (= 10 (car b))(progn
     
255.         (setq q(list (cadr b) (caddr b))d1(vlax-curve-getDistAtPoint ob q))
     
256.         (if p (if (not(member d1 d)) (setq p (append p (list q))d (append d (list d1))))
     
257.           (setq p (list q)))))))
     
258.    ((="POLYLINE"et)
     
259.     (SETQ EN (ENTGET (SETQ E (ENTNEXT E))))
     
260.     (WHILE (/= (CDR (ASSOC 0 EN)) "SEQEND")
     
261.       (SETQ q (CDR (ASSOC 10 EN))d1(vlax-curve-getDistAtPoint ob q)q(reverse(cdr(reverse q))))
     
262.       (if p(if (not(member d1 d)) (setq p (append p (list q))d (append d (list d1))))(setq p(list q)))
     
263.       (SETQ EN (ENTGET (SETQ E (ENTNEXT E)))))
     
264.     (setq p(reverse p))))P)
     
265. 
     
266. (defun c:lw-bl2000 ( / p l0 zb jwd );;;2000坐标多段线TXT转经纬度文件，经纬度为10进制
     
267. 
     
268.   (vl-load-com)
     
269. (setq l0 (getreal "\n请输入中央子午线经度dd.mmss:"))
     
270. (setq p (car(entsel "\n请选择2000或者wgs84坐标多段线：")))
     
271. 
     
272.   (setq zb (vxs p))
     
273. (setq ffn (getfiled "选取/建立数据导出10进制经纬度文件" "" "txt" 1))
     
274.   (setq ff (open ffn "w"))
     
275. (foreach x zb
     
276. (setq jwd (PrjPoint:xy2BL2 x (Dms2Rad l0) 2))
     
277. 
     
278. (write-line (strcat (rtos (car jwd)2 9)","(rtos (cadr jwd)2 9)) ff)
     
279. 
     
280.   )
     
281. (close ff)
     
282.        )
     
283. 
     
284. ;;;;;;;;;;;;;;;;;;;;;;;;;
     
285. (defun c:bl-2000 (  /  l0 fn f ll k lll bbb lllbbb str)  ;;;经纬度文件TXT转2000坐标，图上经纬度为度分秒
     
286. (vl-load-com)
     
287. (setq l0 (getreal "\n请输入中央子午线经度dd.mmss:"))
     
288. (setq fn (getfiled "Select Log file请打开10进制经纬度数据文件：格式为：经度，纬度" "" "txt" 8))
     
289. 
     
290. (setq f (open (findfile fn) "r"))
     
291. 
     
292. (while (setq k (read-line f))
     
293.     (setq ll (cons k  ll ) )
     
294.   )
     
295. (close f)
     
296. ;(String:Split (car ll) ",")
     
297. (foreach x ll
     
298. (setq lll (atof (car(String:Split x ","))))
     
299. (setq bbb (atof (cadr(String:Split x ","))))
     
300. 
     
301. (setq lllbbb( PrjPoint:BL2xy(Degree2Rad bbb) (Degree2Rad lll) (dms2rad l0) 2))
     
302.   (setq str(strcat (10-DDMMSS bbb )","(10-DDMMSS lll )))
     
303. (entmake (list '(0 . "TEXT")'(8 . "jwd") (cons 1 str) (cons 10 lllbbb) (cons 40 2)))
     
304. (entmake (list '(0 . "POINT")'(8 . "jwd") (cons 10 lllbbb)))
     
305.   )
     
306.   (princ)
     
307. )
     
308. 
     
309. (defun String:Split (str delimiter / post strlst stl)
     
310.     (if        str
     
311.       (progn
     
312.         (setq stl (strlen delimiter))
     
313.         (while (vl-string-search delimiter str)
     
314.           (setq        post   (vl-string-search delimiter str)
     
315.                 strlst (cons (substr str 1 post) strlst)
     
316.                 str    (substr str (+ 1 post stl))
     
317.           )
     
318.         )
     
319.         (reverse (vl-remove "" (cons str strlst)))
     
320.       )
     
321.     )
     
322.   )

;;;功能：投影换带<br /> ;;作者:HUA<br /> ;;;创建日期：2020-8-18<br /> ;;;最后编辑日期:2020-8-20<br /> ;;;<br /> ;;;秒转度分秒 s->dd.mmss<br /> (defun Second2Dms(second / sign degree miniute second  dms)<br />   (setq   sign (< second 0)<br />       second (/ (abs second) 3600.0)<br />       degree (fix second)<br />       second (* (- second degree) 60.0)<br />       miniute (fix second)<br />       second (* (- second miniute) 60.0)<br />       dms (+ degree (/ miniute 100.0) (/ second 10000.0))<br />   )<br />   (if sign (setq dms (- 0 dms)))<br />   dms<br /> )<br /> ;;;<br /> ;;;角度转弧度 dd.mmss->rad<br /> (defun Dms2Rad(dms / sign degree miniute second rad)<br />   (setq  sign  (<  dms 0)<br />          dms  (abs dms) <br />        degree (fix dms)<br />        dms (* (- dms degree) 100)<br />        miniute (fix dms)<br />        second (* (- dms miniute) 100)    <br />        rad (/ (* (+ degree (/ miniute 60.0) (/ second 3600.0)) PI) 180.0)<br />   )<br />   (if sign (setq rad  (- 0 rad)))<br />   rad<br /> ) <br /> ;;;<br /> ;;;弧度转角度 rad->dd.mmss<br /> (defun Rad2Dms(rad / sign degree miniute second dms)<br />   (setq   sign (< rad 0)<br />           rad (abs rad)<br />       rad (/ (* rad 180.0) PI)<br />       degree (fix rad)<br />       rad (* (- rad degree) 60.0)<br />       miniute (fix rad)<br />       second (* (- rad miniute) 60.0)<br />       dms (+ degree (/ miniute 100.0) (/ second 10000.0))<br />   )<br />   (if sign (setq dms (- 0 dms)))<br />   dms<br /> )<br /> ;;;<br /> ;;;十进制角度转弧度 dd->rad<br /> (defun Degree2Rad(degree / sign rad)<br />   (setq  sign  (<  degree 0)<br />          degree   (abs degree )       <br />        rad (/ (* degree  PI) 180.0)<br />   )<br />   (if sign (setq rad  (- 0 rad)))<br />   rad<br /> ) <br /> ;;;十进制角度转DD.MMSS<br /> <br /> (DEFUN 10-DDMMSS ( A / B C D E )<br /> (SETQ B (Rad2Dms (Degree2Rad A)) )<br /> (setq c (fix b)) (setq d (fix(*(- b c) 100)))<br /> (setq e (- (* 10000 b) (* c 10000)  (* d 100) ) )<br />   (strcat (rtos c 2 0) "度" (rtos d 2 0) "分"  (rtos e 2 6) "秒")<br />   )<br /> <br /> ;;;弧度转十进制角度 rad->dd<br /> (defun Rad2Degree(rad / sign degree)<br />   (setq  sign  (<  rad 0)<br />          rad (abs rad)<br />          degree (/ (* rad 180.0) PI)<br />   )<br />   (if sign (setq degree  (- 0 degree)))<br />   degree<br /> ) <br /> ;;;<br /> ;;;54坐标系参数<br /> (defun PrjPoint_Krasovsky( / a f e2 e12 A1 A2 A3 A4 A5 A6 A7 tf )<br />   (setq  a 6378245.0<br />       f 298.3<br />       tf (/ (- f 1) f)<br />       e2  (- 1 (* tf tf))<br />       tf (/ f (- f 1))<br />       e12 (- (* tf tf) 1)<br />       A1 6367558.4968749800000000<br />       A2  -16036.4802694116000000<br />       A3  16.8280668841393000<br />       A4  -0.0219753089548841<br />       A5 0.0000311310026601<br />       A6 -0.0000000459827472<br />       A7 0.0000000000679857      <br />   )<br />   (list a f e2 e12 A1 A2 A3 A4 A5 A6 A7)  <br /> )<br /> ;;;<br /> ;;;80坐标系参数<br /> (defun PrjPoint_IUGG1975(/ a f e2 e12 A1 A2 A3 A4 A5 A6 A7 tf)<br />   (setq  a    6378140.0<br />       f    298.257<br />       tf (/ (- f 1) f)<br />       e2  (- 1 (* tf tf))<br />       tf (/ f (- f 1))<br />       e12 (- (* tf tf) 1)<br />       A1    6367452.1327884300000000<br />       A2    -16038.5282286966000000<br />       A3    16.8326464353061000<br />       A4    -0.0219844636486152<br />       A5    0.0000311484690908<br />       A6    -0.0000000460151868<br />       A7    0.0000000000680433      <br />   ) <br />   (list a f e2 e12 A1 A2 A3 A4 A5 A6 A7)  <br /> )<br /> ;;;<br /> ;;;2000坐标系参数<br /> (defun PrjPoint_2000(/ a f e2 e12 A1 A2 A3 A4 A5 A6 A7 tf)<br />   (setq  a    6378137.0<br />       f    298.257222101<br />       tf (/ (- f 1) f)<br />       e2  (- 1 (* tf tf))<br />       tf (/ f (- f 1))<br />       e12 (- (* tf tf) 1)<br />       A1    6367449.1457710400000000<br />       A2    -16038.5087415914000000<br />       A3    16.8326134276660000<br />       A4    -0.0219844041401628<br />       A5    0.0000311483615430<br />       A6    -0.0000000460149936<br />       A7    0.0000000000680429      <br />   )<br />    (list a f e2 e12 A1 A2 A3 A4 A5 A6 A7)  <br /> )<br /> ;;;<br /> ;;;BL转cadx,cady<br /> ;;;输入参数 <br /> ;;;B,L为点位纬度和经度，单位为弧度<br /> ;;;L0为中央经线，单位为弧度<br /> ;;;prjType取值为0:北京54坐标系,1:西安80坐标系，2：CGCS2000坐标系<br /> ;;;输出CAD坐标x,y<br /> (defun PrjPoint:BL2xy(B L L0 prjType / a f e2 e12 A1 A2 A3 A4 A5 A6 A7 X N tanB tanB2 m m2 ng2 sinB cosB cadx cady)    <br />     (cond <br />     ((= 0 prjType) (mapcar 'set (list 'a 'f 'e2 'e12 'A1 'A2 'A3 'A4 'A5 'A6 'A7) (PrjPoint_Krasovsky)))<br />     ((= 1 prjType) (mapcar 'set (list 'a 'f 'e2 'e12 'A1 'A2 'A3 'A4 'A5 'A6 'A7) (PrjPoint_IUGG1975)))<br />     ((= 2 prjType) (mapcar 'set (list 'a 'f 'e2 'e12 'A1 'A2 'A3 'A4 'A5 'A6 'A7) (PrjPoint_2000)))<br />     (T (alert "未知prjType参数值")(exit))<br />   )<br />   (setq  X       (+ (* A1 B) (* A2 (sin (* 2 B))) (*  A3 (sin (* 4 B))) (* A4 (sin (* 6 B))) (* A5  (sin (* 8 B))) (* A6 (sin (* 10 B))) (* A7 (sin (* 12 B))))<br />       sinB   (sin B)  cosB   (cos B) tanB   (/ (sin B) (cos B))   tanB2   (* tanB tanB)<br />       N      (/ a (sqrt (- 1 (* e2 sinB sinB))))<br />       m      (* cosB (- L L0))  m2 (* m m)<br />       ng2      (/ (* cosB cosB e2) (- 1 e2))<br />       cady    (+ X (* N tanB (* (+ 0.5 (* (+ (/ (+ (- 5 tanB2) (* 9 ng2) (* 4 ng2 ng2)) 24.0) (/ (* (+ (- 61 (* 58 tanB2)) (* tanB2 tanB2)) m2) 72.0)) m2)) m2)))<br />       cadx    (+ 500000 (* N m  (+ 1 (* m2 (+ (/ (+ (- 1 tanB2) ng2) 6.0) (/ (* m2 (-  (+ 5 (* tanB2 tanB2) (* 14 ng2)) (* 18 tanB2) (* 58 ng2 tanB2))) 120.0))))))    <br />   )<br />   (list cadx cady)  <br /> )<br /> ;;;<br /> ;;;cadx,cady转BL<br /> ;;;输入参数 <br /> ;;;;pt为点位cad点坐标,<br /> ;;;L0为中央经线，单位为弧度<br /> ;;;prjType取值为0:北京54坐标系,1:西安80坐标系，2：CGCS2000坐标系<br /> ;;;输出经纬度B,L表，单位为dd.mmss<br /> (defun PrjPoint:xy2BL(pt L0 prjType / a f e2 e12 A1 A2 A3 A4 A5 A6 A7 sinB cosB tanB tanB2 N ng2 V yN preB0 B0 eta x y )<br />   (cond <br />     ((= 0 prjType) (mapcar 'set (list 'a 'f 'e2 'e12 'A1 'A2 'A3 'A4 'A5 'A6 'A7) (PrjPoint_Krasovsky)))<br />     ((= 1 prjType) (mapcar 'set (list 'a 'f 'e2 'e12 'A1 'A2 'A3 'A4 'A5 'A6 'A7) (PrjPoint_IUGG1975)))<br />     ((= 2 prjType) (mapcar 'set (list 'a 'f 'e2 'e12 'A1 'A2 'A3 'A4 'A5 'A6 'A7) (PrjPoint_2000)))<br />     (T (alert "未知prjType参数值")(exit))<br />   )<br />   (setq   x    (cadr pt)<br />       y    (- (car pt) 500000)<br />       B0   (/ x A1)<br />       eta  1<br />   )  <br />   (while (> eta  0.000000000048)<br />     (setq  preB0  B0<br />         B0   (/ (- x (+ (* A2 (sin (* 2 B0))) (* A3 (sin (* 4 B0))) (* A4 (sin (* 6 B0))) (* A5 (sin (* 8 B0))) (* A6 (sin (* 10 B0))) (* A7 (sin (* 12 B0))))) A1)<br />         eta (abs (- B0 preB0))<br />     )  <br />   )  <br />   (setq   sinB  (sin B0)<br />       cosB   (cos B0)<br />       tanB    (/ (sin B0) (cos B0))<br />       tanB2   (* tanB tanB) <br />       N      (/ a (sqrt (- 1 (* e2 sinB sinB))))<br />       ng2      (/ (* cosB cosB e2) (- 1 e2))<br />       V    (sqrt (+ 1 ng2))<br />       yN    (/ y N)    <br />       B    (- B0 (* (+ (- (* yN yN) (/ (* (- (+ 5 (* 3 tanB2) ng2) (* 9 ng2 tanB2)) yN yN yN yN) 12.0)) (/ (* (+ 61 (* 90 tanB2) (* 45 tanB2 tanB2)) yN yN yN yN yN yN) 360.0)) V V tanB 0.5))      <br />       L    (+ L0 (/ (+ (- yN (/ (* (+ 1 (* 2 tanB2) ng2) yN yN yN) 6.0 )) (/ (* (+ 5 (* 28 tanB2) (* 24 tanB2 tanB2) (* 6 ng2) (* 8 ng2 tanB2)) yN yN yN yN yN) 120.0)) cosB))    <br />   )<br />   (list (Rad2Dms B) (Rad2Dms L))<br /> )<br /> ;;;<br /> ;;;cadx,cady转BL<br /> ;;;输入参数 <br /> ;;;;pt为点位cad点坐标,<br /> ;;;L0为中央经线，单位为弧度<br /> ;;;prjType取值为0:北京54坐标系,1:西安80坐标系，2：CGCS2000坐标系<br /> ;;;输出经纬度B,L表，单位为十进制<br /> (defun PrjPoint:xy2BL2(pt L0 prjType / a f e2 e12 A1 A2 A3 A4 A5 A6 A7 sinB cosB tanB tanB2 N ng2 V yN preB0 B0 eta x y )<br />   (cond <br />     ((= 0 prjType) (mapcar 'set (list 'a 'f 'e2 'e12 'A1 'A2 'A3 'A4 'A5 'A6 'A7) (PrjPoint_Krasovsky)))<br />     ((= 1 prjType) (mapcar 'set (list 'a 'f 'e2 'e12 'A1 'A2 'A3 'A4 'A5 'A6 'A7) (PrjPoint_IUGG1975)))<br />     ((= 2 prjType) (mapcar 'set (list 'a 'f 'e2 'e12 'A1 'A2 'A3 'A4 'A5 'A6 'A7) (PrjPoint_2000)))<br />     (T (alert "未知prjType参数值")(exit))<br />   )<br />   (setq   x    (cadr pt)<br />       y    (- (car pt) 500000)<br />       B0   (/ x A1)<br />       eta  1<br />   )  <br />   (while (> eta  0.000000000048)<br />     (setq  preB0  B0<br />         B0   (/ (- x (+ (* A2 (sin (* 2 B0))) (* A3 (sin (* 4 B0))) (* A4 (sin (* 6 B0))) (* A5 (sin (* 8 B0))) (* A6 (sin (* 10 B0))) (* A7 (sin (* 12 B0))))) A1)<br />         eta (abs (- B0 preB0))<br />     )  <br />   )  <br />   (setq   sinB  (sin B0)<br />       cosB   (cos B0)<br />       tanB    (/ (sin B0) (cos B0))<br />       tanB2   (* tanB tanB) <br />       N      (/ a (sqrt (- 1 (* e2 sinB sinB))))<br />       ng2      (/ (* cosB cosB e2) (- 1 e2))<br />       V    (sqrt (+ 1 ng2))<br />       yN    (/ y N)    <br />       B    (- B0 (* (+ (- (* yN yN) (/ (* (- (+ 5 (* 3 tanB2) ng2) (* 9 ng2 tanB2)) yN yN yN yN) 12.0)) (/ (* (+ 61 (* 90 tanB2) (* 45 tanB2 tanB2)) yN yN yN yN yN yN) 360.0)) V V tanB 0.5))      <br />       L    (+ L0 (/ (+ (- yN (/ (* (+ 1 (* 2 tanB2) ng2) yN yN yN) 6.0 )) (/ (* (+ 5 (* 28 tanB2) (* 24 tanB2 tanB2) (* 6 ng2) (* 8 ng2 tanB2)) yN yN yN yN yN) 120.0)) cosB))    <br />   )<br />   (list (Rad2Degree L) (Rad2Degree B) )<br /> )<br /> <br /> ;;;;;;;;;;;;;;;;;;;;;;;;;;;<br /> <br /> <br /> (defun c:jw-2000 (   / l0 bb ll vvv str  )<br /> <br /> (setq l0 (getreal "\n请输入中央子午线经度dd.mmss:"))<br /> (setq bb (getreal "\n请输入待求点纬度dd.mmss:"))<br /> (setq ll (getreal "\n请输入待求点经度dd.mmss:"))<br /> <br /> (setq vvv(append(PrjPoint:BL2xy (dms2rad bb) (dms2rad ll) (dms2rad l0)2)'(0)))<br /> (setq str(strcat (rtos bb 2 12 )","(rtos ll 2 12 )))<br /> (entmake (list '(0 . "TEXT")'(8 . "jwd") (cons 1 str) (cons 10 vvv) (cons 40 2)))<br /> (entmake (list '(0 . "POINT")'(8 . "jwd") (cons 10 vvv)))<br />   <br />   )<br /> <br /> (defun vxs(e / p a b n ob q et d d1 en et)<br />     (setq a(entget e)ob(vlax-ename->vla-object e)et(cdr(assoc 0 a))n 0 p nil d nil)<br />     (cond((="LWPOLYLINE"et)<br />     (repeat(length a)(setq b (nth n a) n (+ n 1))<br />       (if (= 10 (car b))(progn<br />         (setq q(list (cadr b) (caddr b))d1(vlax-curve-getDistAtPoint ob q))<br />         (if p (if (not(member d1 d)) (setq p (append p (list q))d (append d (list d1))))<br />           (setq p (list q)))))))<br />    ((="POLYLINE"et)<br />     (SETQ EN (ENTGET (SETQ E (ENTNEXT E))))<br />     (WHILE (/= (CDR (ASSOC 0 EN)) "SEQEND")<br />       (SETQ q (CDR (ASSOC 10 EN))d1(vlax-curve-getDistAtPoint ob q)q(reverse(cdr(reverse q))))<br />       (if p(if (not(member d1 d)) (setq p (append p (list q))d (append d (list d1))))(setq p(list q)))<br />       (SETQ EN (ENTGET (SETQ E (ENTNEXT E)))))<br />     (setq p(reverse p))))P)<br /> <br /> (defun c:lw-bl2000 ( / p l0 zb jwd );;;2000坐标多段线TXT转经纬度文件，经纬度为10进制<br /> <br />   (vl-load-com)<br /> (setq l0 (getreal "\n请输入中央子午线经度dd.mmss:"))<br /> (setq p (car(entsel "\n请选择2000或者wgs84坐标多段线：")))<br /> <br />   (setq zb (vxs p))<br /> (setq ffn (getfiled "选取/建立数据导出10进制经纬度文件" "" "txt" 1))<br />   (setq ff (open ffn "w")) <br /> (foreach x zb<br /> (setq jwd (PrjPoint:xy2BL2 x (Dms2Rad l0) 2))<br /> <br /> (write-line (strcat (rtos (car jwd)2 9)","(rtos (cadr jwd)2 9)) ff)<br /> <br />   )<br /> (close ff)<br />        )<br /> <br /> ;;;;;;;;;;;;;;;;;;;;;;;;;<br /> (defun c:bl-2000 (  /  l0 fn f ll k lll bbb lllbbb str)  ;;;经纬度文件TXT转2000坐标，图上经纬度为度分秒<br /> (vl-load-com)<br /> (setq l0 (getreal "\n请输入中央子午线经度dd.mmss:"))<br /> (setq fn (getfiled "Select Log file请打开10进制经纬度数据文件：格式为：经度，纬度" "" "txt" 8))<br /> <br /> (setq f (open (findfile fn) "r"))<br /> <br /> (while (setq k (read-line f))<br />     (setq ll (cons k  ll ) )<br />   )<br /> (close f)<br /> ;(String:Split (car ll) ",")<br /> (foreach x ll<br /> (setq lll (atof (car(String:Split x ","))))<br /> (setq bbb (atof (cadr(String:Split x ","))))<br /> <br /> (setq lllbbb( PrjPoint:BL2xy(Degree2Rad bbb) (Degree2Rad lll) (dms2rad l0) 2))<br />   (setq str(strcat (10-DDMMSS bbb )","(10-DDMMSS lll )))<br /> (entmake (list '(0 . "TEXT")'(8 . "jwd") (cons 1 str) (cons 10 lllbbb) (cons 40 2)))<br /> (entmake (list '(0 . "POINT")'(8 . "jwd") (cons 10 lllbbb)))<br />   )<br />   (princ)<br /> )<br /> <br /> (defun String:Split (str delimiter / post strlst stl)<br />     (if        str<br />       (progn<br />         (setq stl (strlen delimiter))<br />         (while (vl-string-search delimiter str)<br />           (setq        post   (vl-string-search delimiter str)<br />                 strlst (cons (substr str 1 post) strlst)<br />                 str    (substr str (+ 1 post stl))<br />           )<br />         )<br />         (reverse (vl-remove "" (cons str strlst)))<br />       )<br />     )<br />   )

烟盒迷唇

谢谢分享啊

664571221

兄弟你qq多少可以加你一下吗

树櫴希德

根据4参数算坐标？

1. ;;;角度转弧度 dd.mmss->rad
   
2. (defun Dms2Rad(dms / sign degree miniute second rad)
   
3.   (setq  sign  (<  dms 0)
   
4.          dms  (abs dms)
   
5.        degree (fix dms)
   
6.        dms (* (- dms degree) 100)
   
7.        miniute (fix dms)
   
8.        second (* (- dms miniute) 100)   
   
9.        rad (/ (* (+ degree (/ miniute 60.0) (/ second 3600.0)) PI) 180.0)
   
10.   )
    
11.   (if sign (setq rad  (- 0 rad)))
    
12.   rad
    
13. )
    
14. ;;;
    
15. (setq pp'(40 50))
    
16. 
    
17. (setq aa(Dms2Rad(getreal "\n请输入旋转角度dd.mmss:")))
    
18. (setq kk(getreal "\n请输入尺度1.00000:"))
    
19. 
    
20. ;;;;;;;;;;;;;;;;;;;
    
21. (defun zbzh ( pp aa kk /   xx yy x0 y0 )
    
22. 
    
23. 
    
24. (setq xx (cadr pp) yy  (car pp) )
    
25. 
    
26. (setq x0   (* (cos aa)  (- (* xx kk)    (* (/ (sin aa) (cos aa)) (* kk  yy) )              )  )     )
    
27. 
    
28. ;
    
29. 
    
30. (setq y0 (+  (/ (* kk  yy) (cos aa))   (* (/ (sin aa) (cos aa)) x0 )      ))
    
31.   
    
32.   (list y0 x0)
    
33. 
    
34.   )

;;;角度转弧度 dd.mmss->rad<br /> (defun Dms2Rad(dms / sign degree miniute second rad)<br />   (setq  sign  (<  dms 0)<br />          dms  (abs dms) <br />        degree (fix dms)<br />        dms (* (- dms degree) 100)<br />        miniute (fix dms)<br />        second (* (- dms miniute) 100)    <br />        rad (/ (* (+ degree (/ miniute 60.0) (/ second 3600.0)) PI) 180.0)<br />   )<br />   (if sign (setq rad  (- 0 rad)))<br />   rad<br /> ) <br /> ;;;<br /> (setq pp'(40 50))<br /> <br /> (setq aa(Dms2Rad(getreal "\n请输入旋转角度dd.mmss:")))<br /> (setq kk(getreal "\n请输入尺度1.00000:"))<br /> <br /> ;;;;;;;;;;;;;;;;;;;<br /> (defun zbzh ( pp aa kk /   xx yy x0 y0 )<br /> <br /> <br /> (setq xx (cadr pp) yy  (car pp) )<br /> <br /> (setq x0   (* (cos aa)  (- (* xx kk)    (* (/ (sin aa) (cos aa)) (* kk  yy) )              )  )     )<br /> <br /> ;<br /> <br /> (setq y0 (+  (/ (* kk  yy) (cos aa))   (* (/ (sin aa) (cos aa)) x0 )      ))<br />   <br />   (list y0 x0)<br /> <br />   )

树櫴希德

地方坐标系或者自定义坐标根据4参数多段线转经纬度文件TXT，经纬度为10进制，可以复制到KML文件用\n"  "可以将手薄里面参与求控制点的WGS84经纬度换算成坐标\n" "然后用COORD笑脸软件求地方坐标--》WGS84坐标的4参数抄下来用113.47228431,22.986922997
113.472186361,22.986816298
113.472054915,22.986774606
113.4719921,22.986754673
113.471037673,22.984983334
113.471092087,22.984715313
113.470541912,22.985446895
113.470968935,22.985462633
113.471749262,22.986910865
113.471755997,22.986923274
113.471762811,22.986935665
113.471769664,22.98694801
113.471776604,22.986960328
113.471783612,22.98697261
113.471790689,22.986984865
113.471797844,22.986997093
113.471805047,22.987009266
113.471812319,22.987021422
113.471819678,22.987033532
113.471827087,22.987045624
113.471834553,22.987057671
113.471842108,22.987069681
113.47184972,22.987081638
113.471857401,22.987093585
113.471865131,22.987105478
113.471872949,22.987117353
113.471880815,22.987129182
113.471888769,22.987140957
113.471896772,22.987152715
113.471904843,22.987164427
113.471912982,22.987176102
113.47192117,22.987187742
113.471929445,22.987199327
113.471937769,22.987210886
113.471946172,22.987222408
113.471954613,22.987233894
113.471963142,22.987245325
113.471971719,22.987256721

1. ;;;功能：投影换带
   
2. ;;作者:HUA
   
3. ;;;创建日期：2020-8-18
   
4. ;;;最后编辑日期:2020-8-20
   
5. ;;;
   
6. ;;;秒转度分秒 s->dd.mmss
   
7. (defun Second2Dms(second / sign degree miniute second  dms)
   
8.   (setq   sign (< second 0)
   
9.       second (/ (abs second) 3600.0)
   
10.       degree (fix second)
    
11.       second (* (- second degree) 60.0)
    
12.       miniute (fix second)
    
13.       second (* (- second miniute) 60.0)
    
14.       dms (+ degree (/ miniute 100.0) (/ second 10000.0))
    
15.   )
    
16.   (if sign (setq dms (- 0 dms)))
    
17.   dms
    
18. )
    
19. ;;;
    
20. ;;;角度转弧度 dd.mmss->rad
    
21. (defun Dms2Rad(dms / sign degree miniute second rad)
    
22.   (setq  sign  (<  dms 0)
    
23.          dms  (abs dms)
    
24.        degree (fix dms)
    
25.        dms (* (- dms degree) 100)
    
26.        miniute (fix dms)
    
27.        second (* (- dms miniute) 100)   
    
28.        rad (/ (* (+ degree (/ miniute 60.0) (/ second 3600.0)) PI) 180.0)
    
29.   )
    
30.   (if sign (setq rad  (- 0 rad)))
    
31.   rad
    
32. )
    
33. ;;;
    
34. ;;;弧度转角度 rad->dd.mmss
    
35. (defun Rad2Dms(rad / sign degree miniute second dms)
    
36.   (setq   sign (< rad 0)
    
37.           rad (abs rad)
    
38.       rad (/ (* rad 180.0) PI)
    
39.       degree (fix rad)
    
40.       rad (* (- rad degree) 60.0)
    
41.       miniute (fix rad)
    
42.       second (* (- rad miniute) 60.0)
    
43.       dms (+ degree (/ miniute 100.0) (/ second 10000.0))
    
44.   )
    
45.   (if sign (setq dms (- 0 dms)))
    
46.   dms
    
47. )
    
48. ;;;
    
49. ;;;十进制角度转弧度 dd->rad
    
50. (defun Degree2Rad(degree / sign rad)
    
51.   (setq  sign  (<  degree 0)
    
52.          degree   (abs degree )      
    
53.        rad (/ (* degree  PI) 180.0)
    
54.   )
    
55.   (if sign (setq rad  (- 0 rad)))
    
56.   rad
    
57. )
    
58. ;;;十进制角度转DD.MMSS
    
59. 
    
60. (DEFUN 10-DDMMSS ( A / B C D E )
    
61. (SETQ B (Rad2Dms (Degree2Rad A)) )
    
62. (setq c (fix b)) (setq d (fix(*(- b c) 100)))
    
63. (setq e (- (* 10000 b) (* c 10000)  (* d 100) ) )
    
64.   (strcat (rtos c 2 0) "度" (rtos d 2 0) "分"  (rtos e 2 6) "秒")
    
65.   )
    
66. 
    
67. ;;;弧度转十进制角度 rad->dd
    
68. (defun Rad2Degree(rad / sign degree)
    
69.   (setq  sign  (<  rad 0)
    
70.          rad (abs rad)
    
71.          degree (/ (* rad 180.0) PI)
    
72.   )
    
73.   (if sign (setq degree  (- 0 degree)))
    
74.   degree
    
75. )
    
76. ;;;
    
77. ;;;54坐标系参数
    
78. (defun PrjPoint_Krasovsky( / a f e2 e12 A1 A2 A3 A4 A5 A6 A7 tf )
    
79.   (setq  a 6378245.0
    
80.       f 298.3
    
81.       tf (/ (- f 1) f)
    
82.       e2  (- 1 (* tf tf))
    
83.       tf (/ f (- f 1))
    
84.       e12 (- (* tf tf) 1)
    
85.       A1 6367558.4968749800000000
    
86.       A2  -16036.4802694116000000
    
87.       A3  16.8280668841393000
    
88.       A4  -0.0219753089548841
    
89.       A5 0.0000311310026601
    
90.       A6 -0.0000000459827472
    
91.       A7 0.0000000000679857      
    
92.   )
    
93.   (list a f e2 e12 A1 A2 A3 A4 A5 A6 A7)  
    
94. )
    
95. ;;;
    
96. ;;;80坐标系参数
    
97. (defun PrjPoint_IUGG1975(/ a f e2 e12 A1 A2 A3 A4 A5 A6 A7 tf)
    
98.   (setq  a    6378140.0
    
99.       f    298.257
    
100.       tf (/ (- f 1) f)
     
101.       e2  (- 1 (* tf tf))
     
102.       tf (/ f (- f 1))
     
103.       e12 (- (* tf tf) 1)
     
104.       A1    6367452.1327884300000000
     
105.       A2    -16038.5282286966000000
     
106.       A3    16.8326464353061000
     
107.       A4    -0.0219844636486152
     
108.       A5    0.0000311484690908
     
109.       A6    -0.0000000460151868
     
110.       A7    0.0000000000680433      
     
111.   )
     
112.   (list a f e2 e12 A1 A2 A3 A4 A5 A6 A7)  
     
113. )
     
114. ;;;
     
115. ;;;2000坐标系参数
     
116. (defun PrjPoint_2000(/ a f e2 e12 A1 A2 A3 A4 A5 A6 A7 tf)
     
117.   (setq  a    6378137.0
     
118.       f    298.257222101
     
119.       tf (/ (- f 1) f)
     
120.       e2  (- 1 (* tf tf))
     
121.       tf (/ f (- f 1))
     
122.       e12 (- (* tf tf) 1)
     
123.       A1    6367449.1457710400000000
     
124.       A2    -16038.5087415914000000
     
125.       A3    16.8326134276660000
     
126.       A4    -0.0219844041401628
     
127.       A5    0.0000311483615430
     
128.       A6    -0.0000000460149936
     
129.       A7    0.0000000000680429      
     
130.   )
     
131.    (list a f e2 e12 A1 A2 A3 A4 A5 A6 A7)  
     
132. )
     
133. ;;;
     
134. ;;;BL转cadx,cady
     
135. ;;;输入参数
     
136. ;;;B,L为点位纬度和经度，单位为弧度
     
137. ;;;L0为中央经线，单位为弧度
     
138. ;;;prjType取值为0:北京54坐标系,1:西安80坐标系，2：CGCS2000坐标系
     
139. ;;;输出CAD坐标x,y
     
140. (defun PrjPoint:BL2xy(B L L0 prjType / a f e2 e12 A1 A2 A3 A4 A5 A6 A7 X N tanB tanB2 m m2 ng2 sinB cosB cadx cady)   
     
141.     (cond
     
142.     ((= 0 prjType) (mapcar 'set (list 'a 'f 'e2 'e12 'A1 'A2 'A3 'A4 'A5 'A6 'A7) (PrjPoint_Krasovsky)))
     
143.     ((= 1 prjType) (mapcar 'set (list 'a 'f 'e2 'e12 'A1 'A2 'A3 'A4 'A5 'A6 'A7) (PrjPoint_IUGG1975)))
     
144.     ((= 2 prjType) (mapcar 'set (list 'a 'f 'e2 'e12 'A1 'A2 'A3 'A4 'A5 'A6 'A7) (PrjPoint_2000)))
     
145.     (T (alert "未知prjType参数值")(exit))
     
146.   )
     
147.   (setq  X       (+ (* A1 B) (* A2 (sin (* 2 B))) (*  A3 (sin (* 4 B))) (* A4 (sin (* 6 B))) (* A5  (sin (* 8 B))) (* A6 (sin (* 10 B))) (* A7 (sin (* 12 B))))
     
148.       sinB   (sin B)  cosB   (cos B) tanB   (/ (sin B) (cos B))   tanB2   (* tanB tanB)
     
149.       N      (/ a (sqrt (- 1 (* e2 sinB sinB))))
     
150.       m      (* cosB (- L L0))  m2 (* m m)
     
151.       ng2      (/ (* cosB cosB e2) (- 1 e2))
     
152.       cady    (+ X (* N tanB (* (+ 0.5 (* (+ (/ (+ (- 5 tanB2) (* 9 ng2) (* 4 ng2 ng2)) 24.0) (/ (* (+ (- 61 (* 58 tanB2)) (* tanB2 tanB2)) m2) 72.0)) m2)) m2)))
     
153.       cadx    (+ 500000 (* N m  (+ 1 (* m2 (+ (/ (+ (- 1 tanB2) ng2) 6.0) (/ (* m2 (-  (+ 5 (* tanB2 tanB2) (* 14 ng2)) (* 18 tanB2) (* 58 ng2 tanB2))) 120.0))))))   
     
154.   )
     
155.   (list cadx cady)  
     
156. )
     
157. ;;;
     
158. ;;;cadx,cady转BL
     
159. ;;;输入参数
     
160. ;;;;pt为点位cad点坐标,
     
161. ;;;L0为中央经线，单位为弧度
     
162. ;;;prjType取值为0:北京54坐标系,1:西安80坐标系，2：CGCS2000坐标系
     
163. ;;;输出经纬度B,L表，单位为dd.mmss
     
164. (defun PrjPoint:xy2BL(pt L0 prjType / a f e2 e12 A1 A2 A3 A4 A5 A6 A7 sinB cosB tanB tanB2 N ng2 V yN preB0 B0 eta x y )
     
165.   (cond
     
166.     ((= 0 prjType) (mapcar 'set (list 'a 'f 'e2 'e12 'A1 'A2 'A3 'A4 'A5 'A6 'A7) (PrjPoint_Krasovsky)))
     
167.     ((= 1 prjType) (mapcar 'set (list 'a 'f 'e2 'e12 'A1 'A2 'A3 'A4 'A5 'A6 'A7) (PrjPoint_IUGG1975)))
     
168.     ((= 2 prjType) (mapcar 'set (list 'a 'f 'e2 'e12 'A1 'A2 'A3 'A4 'A5 'A6 'A7) (PrjPoint_2000)))
     
169.     (T (alert "未知prjType参数值")(exit))
     
170.   )
     
171.   (setq   x    (cadr pt)
     
172.       y    (- (car pt) 500000)
     
173.       B0   (/ x A1)
     
174.       eta  1
     
175.   )  
     
176.   (while (> eta  0.000000000048)
     
177.     (setq  preB0  B0
     
178.         B0   (/ (- x (+ (* A2 (sin (* 2 B0))) (* A3 (sin (* 4 B0))) (* A4 (sin (* 6 B0))) (* A5 (sin (* 8 B0))) (* A6 (sin (* 10 B0))) (* A7 (sin (* 12 B0))))) A1)
     
179.         eta (abs (- B0 preB0))
     
180.     )  
     
181.   )  
     
182.   (setq   sinB  (sin B0)
     
183.       cosB   (cos B0)
     
184.       tanB    (/ (sin B0) (cos B0))
     
185.       tanB2   (* tanB tanB)
     
186.       N      (/ a (sqrt (- 1 (* e2 sinB sinB))))
     
187.       ng2      (/ (* cosB cosB e2) (- 1 e2))
     
188.       V    (sqrt (+ 1 ng2))
     
189.       yN    (/ y N)   
     
190.       B    (- B0 (* (+ (- (* yN yN) (/ (* (- (+ 5 (* 3 tanB2) ng2) (* 9 ng2 tanB2)) yN yN yN yN) 12.0)) (/ (* (+ 61 (* 90 tanB2) (* 45 tanB2 tanB2)) yN yN yN yN yN yN) 360.0)) V V tanB 0.5))      
     
191.       L    (+ L0 (/ (+ (- yN (/ (* (+ 1 (* 2 tanB2) ng2) yN yN yN) 6.0 )) (/ (* (+ 5 (* 28 tanB2) (* 24 tanB2 tanB2) (* 6 ng2) (* 8 ng2 tanB2)) yN yN yN yN yN) 120.0)) cosB))   
     
192.   )
     
193.   (list (Rad2Dms B) (Rad2Dms L))
     
194. )
     
195. ;;;
     
196. ;;;cadx,cady转BL
     
197. ;;;输入参数
     
198. ;;;;pt为点位cad点坐标,
     
199. ;;;L0为中央经线，单位为弧度
     
200. ;;;prjType取值为0:北京54坐标系,1:西安80坐标系，2：CGCS2000坐标系
     
201. ;;;输出经纬度B,L表，单位为十进制
     
202. (defun PrjPoint:xy2BL2(pt L0 prjType / a f e2 e12 A1 A2 A3 A4 A5 A6 A7 sinB cosB tanB tanB2 N ng2 V yN preB0 B0 eta x y )
     
203.   (cond
     
204.     ((= 0 prjType) (mapcar 'set (list 'a 'f 'e2 'e12 'A1 'A2 'A3 'A4 'A5 'A6 'A7) (PrjPoint_Krasovsky)))
     
205.     ((= 1 prjType) (mapcar 'set (list 'a 'f 'e2 'e12 'A1 'A2 'A3 'A4 'A5 'A6 'A7) (PrjPoint_IUGG1975)))
     
206.     ((= 2 prjType) (mapcar 'set (list 'a 'f 'e2 'e12 'A1 'A2 'A3 'A4 'A5 'A6 'A7) (PrjPoint_2000)))
     
207.     (T (alert "未知prjType参数值")(exit))
     
208.   )
     
209.   (setq   x    (cadr pt)
     
210.       y    (- (car pt) 500000)
     
211.       B0   (/ x A1)
     
212.       eta  1
     
213.   )  
     
214.   (while (> eta  0.000000000048)
     
215.     (setq  preB0  B0
     
216.         B0   (/ (- x (+ (* A2 (sin (* 2 B0))) (* A3 (sin (* 4 B0))) (* A4 (sin (* 6 B0))) (* A5 (sin (* 8 B0))) (* A6 (sin (* 10 B0))) (* A7 (sin (* 12 B0))))) A1)
     
217.         eta (abs (- B0 preB0))
     
218.     )  
     
219.   )  
     
220.   (setq   sinB  (sin B0)
     
221.       cosB   (cos B0)
     
222.       tanB    (/ (sin B0) (cos B0))
     
223.       tanB2   (* tanB tanB)
     
224.       N      (/ a (sqrt (- 1 (* e2 sinB sinB))))
     
225.       ng2      (/ (* cosB cosB e2) (- 1 e2))
     
226.       V    (sqrt (+ 1 ng2))
     
227.       yN    (/ y N)   
     
228.       B    (- B0 (* (+ (- (* yN yN) (/ (* (- (+ 5 (* 3 tanB2) ng2) (* 9 ng2 tanB2)) yN yN yN yN) 12.0)) (/ (* (+ 61 (* 90 tanB2) (* 45 tanB2 tanB2)) yN yN yN yN yN yN) 360.0)) V V tanB 0.5))      
     
229.       L    (+ L0 (/ (+ (- yN (/ (* (+ 1 (* 2 tanB2) ng2) yN yN yN) 6.0 )) (/ (* (+ 5 (* 28 tanB2) (* 24 tanB2 tanB2) (* 6 ng2) (* 8 ng2 tanB2)) yN yN yN yN yN) 120.0)) cosB))   
     
230.   )
     
231.   (list (Rad2Degree L) (Rad2Degree B) )
     
232. )
     
233. 
     
234. ;;;;;;;;;;;;;;;;;;;;;;;;;;;
     
235. ;;;;;;;;;;;;;;;
     
236. 
     
237. (defun vxs(e / p a b n ob q et d d1 en et)
     
238.     (setq a(entget e)ob(vlax-ename->vla-object e)et(cdr(assoc 0 a))n 0 p nil d nil)
     
239.     (cond((="LWPOLYLINE"et)
     
240.     (repeat(length a)(setq b (nth n a) n (+ n 1))
     
241.       (if (= 10 (car b))(progn
     
242.         (setq q(list (cadr b) (caddr b))d1(vlax-curve-getDistAtPoint ob q))
     
243.         (if p (if (not(member d1 d)) (setq p (append p (list q))d (append d (list d1))))
     
244.           (setq p (list q)))))))
     
245.    ((="POLYLINE"et)
     
246.     (SETQ EN (ENTGET (SETQ E (ENTNEXT E))))
     
247.     (WHILE (/= (CDR (ASSOC 0 EN)) "SEQEND")
     
248.       (SETQ q (CDR (ASSOC 10 EN))d1(vlax-curve-getDistAtPoint ob q)q(reverse(cdr(reverse q))))
     
249.       (if p(if (not(member d1 d)) (setq p (append p (list q))d (append d (list d1))))(setq p(list q)))
     
250.       (SETQ EN (ENTGET (SETQ E (ENTNEXT E)))))
     
251.     (setq p(reverse p))))P)
     
252. 
     
253. 
     
254. ;;;;;;;;;;;;;;;;;;;
     
255. (defun zbzh ( pp aa kk /   xx yy x0 y0 )
     
256. 
     
257. 
     
258. (setq xx (cadr pp) yy  (car pp) )
     
259. 
     
260. (setq x0   (* (cos aa)  (- (* xx kk)    (* (/ (sin aa) (cos aa)) (* kk  yy) )              )  )     )
     
261. 
     
262. ;
     
263. 
     
264. (setq y0 (+  (/ (* kk  yy) (cos aa))   (* (/ (sin aa) (cos aa)) x0 )      ))
     
265.   
     
266.   (list (+ y0 (car syd))  (+ x0 (cadr syd))  )
     
267. 
     
268.   )
     
269. ;3、点表生成多段线
     
270. (defun makepl (lst / pt)
     
271. (entmake (append    (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(8 . "ctpzx") (cons 90 (length lst)) (cons 70 129))
     
272.       (mapcar '(lambda (pt)(cons 10 pt)) lst ))
     
273.   ) )
     
274. ;;;;;;
     
275. 
     
276. (defun c:dflw-bl2000 ( / p l0 zb jwd syd aa kk xzb  lll);;;地方坐标系或者自定义坐标根据4参数多段线转经纬度文件TXT，经纬度为10进制，可以复制到KML文件用
     
277. (alert (strcat "地方坐标系或者自定义坐标根据4参数多段线转经纬度文件TXT，经纬度为10进制，可以复制到KML文件用\n"  "可以将手薄里面参与求控制点的WGS84经纬度换算成坐标\n" "然后用COORD笑脸软件求地方坐标--》WGS84坐标的4参数抄下来用"))
     
278.   (vl-load-com)
     
279. (setq l0 (getreal "\n请输入中央子午线经度dd.mmss:"))
     
280. (setq p (car(entsel "\n请选择地方坐标系或者自定义坐标多段线：")))
     
281. 
     
282. ;(setq pp '(62295.5790 17258.584))
     
283. 
     
284. (setq syd'(454891.370478 2529629.687669 )) ;4参数x y位移人工输入
     
285. 
     
286. (setq aa (Dms2Rad 0.0047650491))   ;4参数旋转参数人工输入dd.mmss
     
287. (setq kk 1.00000515799711)      ;4参数缩放比列因子人工输入
     
288.     (setq zb (vxs p))
     
289. (setq lll '())
     
290. (foreach y zb
     
291.     (setq lll (zbzh y aa kk))
     
292.     (setq xzb (cons lll xzb))
     
293.   )
     
294.   (makepl xzb)
     
295. (setq ffn (getfiled "选取/建立数据导出10进制经纬度文件" "" "txt" 1))
     
296.   (setq ff (open ffn "w"))
     
297. (foreach x xzb
     
298. (setq jwd (PrjPoint:xy2BL2 x (Dms2Rad l0) 2))
     
299. 
     
300. (write-line (strcat (rtos (car jwd)2 9)","(rtos (cadr jwd)2 9)) ff)
     
301. 
     
302.   )
     
303. (close ff)
     
304.        )

;;;功能：投影换带<br /> ;;作者:HUA<br /> ;;;创建日期：2020-8-18<br /> ;;;最后编辑日期:2020-8-20<br /> ;;;<br /> ;;;秒转度分秒 s->dd.mmss<br /> (defun Second2Dms(second / sign degree miniute second  dms)<br />   (setq   sign (< second 0)<br />       second (/ (abs second) 3600.0)<br />       degree (fix second)<br />       second (* (- second degree) 60.0)<br />       miniute (fix second)<br />       second (* (- second miniute) 60.0)<br />       dms (+ degree (/ miniute 100.0) (/ second 10000.0))<br />   )<br />   (if sign (setq dms (- 0 dms)))<br />   dms<br /> )<br /> ;;;<br /> ;;;角度转弧度 dd.mmss->rad<br /> (defun Dms2Rad(dms / sign degree miniute second rad)<br />   (setq  sign  (<  dms 0)<br />          dms  (abs dms) <br />        degree (fix dms)<br />        dms (* (- dms degree) 100)<br />        miniute (fix dms)<br />        second (* (- dms miniute) 100)    <br />        rad (/ (* (+ degree (/ miniute 60.0) (/ second 3600.0)) PI) 180.0)<br />   )<br />   (if sign (setq rad  (- 0 rad)))<br />   rad<br /> ) <br /> ;;;<br /> ;;;弧度转角度 rad->dd.mmss<br /> (defun Rad2Dms(rad / sign degree miniute second dms)<br />   (setq   sign (< rad 0)<br />           rad (abs rad)<br />       rad (/ (* rad 180.0) PI)<br />       degree (fix rad)<br />       rad (* (- rad degree) 60.0)<br />       miniute (fix rad)<br />       second (* (- rad miniute) 60.0)<br />       dms (+ degree (/ miniute 100.0) (/ second 10000.0))<br />   )<br />   (if sign (setq dms (- 0 dms)))<br />   dms<br /> )<br /> ;;;<br /> ;;;十进制角度转弧度 dd->rad<br /> (defun Degree2Rad(degree / sign rad)<br />   (setq  sign  (<  degree 0)<br />          degree   (abs degree )       <br />        rad (/ (* degree  PI) 180.0)<br />   )<br />   (if sign (setq rad  (- 0 rad)))<br />   rad<br /> ) <br /> ;;;十进制角度转DD.MMSS<br /> <br /> (DEFUN 10-DDMMSS ( A / B C D E )<br /> (SETQ B (Rad2Dms (Degree2Rad A)) )<br /> (setq c (fix b)) (setq d (fix(*(- b c) 100)))<br /> (setq e (- (* 10000 b) (* c 10000)  (* d 100) ) )<br />   (strcat (rtos c 2 0) "度" (rtos d 2 0) "分"  (rtos e 2 6) "秒")<br />   )<br /> <br /> ;;;弧度转十进制角度 rad->dd<br /> (defun Rad2Degree(rad / sign degree)<br />   (setq  sign  (<  rad 0)<br />          rad (abs rad)<br />          degree (/ (* rad 180.0) PI)<br />   )<br />   (if sign (setq degree  (- 0 degree)))<br />   degree<br /> ) <br /> ;;;<br /> ;;;54坐标系参数<br /> (defun PrjPoint_Krasovsky( / a f e2 e12 A1 A2 A3 A4 A5 A6 A7 tf )<br />   (setq  a 6378245.0<br />       f 298.3<br />       tf (/ (- f 1) f)<br />       e2  (- 1 (* tf tf))<br />       tf (/ f (- f 1))<br />       e12 (- (* tf tf) 1)<br />       A1 6367558.4968749800000000<br />       A2  -16036.4802694116000000<br />       A3  16.8280668841393000<br />       A4  -0.0219753089548841<br />       A5 0.0000311310026601<br />       A6 -0.0000000459827472<br />       A7 0.0000000000679857      <br />   )<br />   (list a f e2 e12 A1 A2 A3 A4 A5 A6 A7)  <br /> )<br /> ;;;<br /> ;;;80坐标系参数<br /> (defun PrjPoint_IUGG1975(/ a f e2 e12 A1 A2 A3 A4 A5 A6 A7 tf)<br />   (setq  a    6378140.0<br />       f    298.257<br />       tf (/ (- f 1) f)<br />       e2  (- 1 (* tf tf))<br />       tf (/ f (- f 1))<br />       e12 (- (* tf tf) 1)<br />       A1    6367452.1327884300000000<br />       A2    -16038.5282286966000000<br />       A3    16.8326464353061000<br />       A4    -0.0219844636486152<br />       A5    0.0000311484690908<br />       A6    -0.0000000460151868<br />       A7    0.0000000000680433      <br />   ) <br />   (list a f e2 e12 A1 A2 A3 A4 A5 A6 A7)  <br /> )<br /> ;;;<br /> ;;;2000坐标系参数<br /> (defun PrjPoint_2000(/ a f e2 e12 A1 A2 A3 A4 A5 A6 A7 tf)<br />   (setq  a    6378137.0<br />       f    298.257222101<br />       tf (/ (- f 1) f)<br />       e2  (- 1 (* tf tf))<br />       tf (/ f (- f 1))<br />       e12 (- (* tf tf) 1)<br />       A1    6367449.1457710400000000<br />       A2    -16038.5087415914000000<br />       A3    16.8326134276660000<br />       A4    -0.0219844041401628<br />       A5    0.0000311483615430<br />       A6    -0.0000000460149936<br />       A7    0.0000000000680429      <br />   )<br />    (list a f e2 e12 A1 A2 A3 A4 A5 A6 A7)  <br /> )<br /> ;;;<br /> ;;;BL转cadx,cady<br /> ;;;输入参数 <br /> ;;;B,L为点位纬度和经度，单位为弧度<br /> ;;;L0为中央经线，单位为弧度<br /> ;;;prjType取值为0:北京54坐标系,1:西安80坐标系，2：CGCS2000坐标系<br /> ;;;输出CAD坐标x,y<br /> (defun PrjPoint:BL2xy(B L L0 prjType / a f e2 e12 A1 A2 A3 A4 A5 A6 A7 X N tanB tanB2 m m2 ng2 sinB cosB cadx cady)    <br />     (cond <br />     ((= 0 prjType) (mapcar 'set (list 'a 'f 'e2 'e12 'A1 'A2 'A3 'A4 'A5 'A6 'A7) (PrjPoint_Krasovsky)))<br />     ((= 1 prjType) (mapcar 'set (list 'a 'f 'e2 'e12 'A1 'A2 'A3 'A4 'A5 'A6 'A7) (PrjPoint_IUGG1975)))<br />     ((= 2 prjType) (mapcar 'set (list 'a 'f 'e2 'e12 'A1 'A2 'A3 'A4 'A5 'A6 'A7) (PrjPoint_2000)))<br />     (T (alert "未知prjType参数值")(exit))<br />   )<br />   (setq  X       (+ (* A1 B) (* A2 (sin (* 2 B))) (*  A3 (sin (* 4 B))) (* A4 (sin (* 6 B))) (* A5  (sin (* 8 B))) (* A6 (sin (* 10 B))) (* A7 (sin (* 12 B))))<br />       sinB   (sin B)  cosB   (cos B) tanB   (/ (sin B) (cos B))   tanB2   (* tanB tanB)<br />       N      (/ a (sqrt (- 1 (* e2 sinB sinB))))<br />       m      (* cosB (- L L0))  m2 (* m m)<br />       ng2      (/ (* cosB cosB e2) (- 1 e2))<br />       cady    (+ X (* N tanB (* (+ 0.5 (* (+ (/ (+ (- 5 tanB2) (* 9 ng2) (* 4 ng2 ng2)) 24.0) (/ (* (+ (- 61 (* 58 tanB2)) (* tanB2 tanB2)) m2) 72.0)) m2)) m2)))<br />       cadx    (+ 500000 (* N m  (+ 1 (* m2 (+ (/ (+ (- 1 tanB2) ng2) 6.0) (/ (* m2 (-  (+ 5 (* tanB2 tanB2) (* 14 ng2)) (* 18 tanB2) (* 58 ng2 tanB2))) 120.0))))))    <br />   )<br />   (list cadx cady)  <br /> )<br /> ;;;<br /> ;;;cadx,cady转BL<br /> ;;;输入参数 <br /> ;;;;pt为点位cad点坐标,<br /> ;;;L0为中央经线，单位为弧度<br /> ;;;prjType取值为0:北京54坐标系,1:西安80坐标系，2：CGCS2000坐标系<br /> ;;;输出经纬度B,L表，单位为dd.mmss<br /> (defun PrjPoint:xy2BL(pt L0 prjType / a f e2 e12 A1 A2 A3 A4 A5 A6 A7 sinB cosB tanB tanB2 N ng2 V yN preB0 B0 eta x y )<br />   (cond <br />     ((= 0 prjType) (mapcar 'set (list 'a 'f 'e2 'e12 'A1 'A2 'A3 'A4 'A5 'A6 'A7) (PrjPoint_Krasovsky)))<br />     ((= 1 prjType) (mapcar 'set (list 'a 'f 'e2 'e12 'A1 'A2 'A3 'A4 'A5 'A6 'A7) (PrjPoint_IUGG1975)))<br />     ((= 2 prjType) (mapcar 'set (list 'a 'f 'e2 'e12 'A1 'A2 'A3 'A4 'A5 'A6 'A7) (PrjPoint_2000)))<br />     (T (alert "未知prjType参数值")(exit))<br />   )<br />   (setq   x    (cadr pt)<br />       y    (- (car pt) 500000)<br />       B0   (/ x A1)<br />       eta  1<br />   )  <br />   (while (> eta  0.000000000048)<br />     (setq  preB0  B0<br />         B0   (/ (- x (+ (* A2 (sin (* 2 B0))) (* A3 (sin (* 4 B0))) (* A4 (sin (* 6 B0))) (* A5 (sin (* 8 B0))) (* A6 (sin (* 10 B0))) (* A7 (sin (* 12 B0))))) A1)<br />         eta (abs (- B0 preB0))<br />     )  <br />   )  <br />   (setq   sinB  (sin B0)<br />       cosB   (cos B0)<br />       tanB    (/ (sin B0) (cos B0))<br />       tanB2   (* tanB tanB) <br />       N      (/ a (sqrt (- 1 (* e2 sinB sinB))))<br />       ng2      (/ (* cosB cosB e2) (- 1 e2))<br />       V    (sqrt (+ 1 ng2))<br />       yN    (/ y N)    <br />       B    (- B0 (* (+ (- (* yN yN) (/ (* (- (+ 5 (* 3 tanB2) ng2) (* 9 ng2 tanB2)) yN yN yN yN) 12.0)) (/ (* (+ 61 (* 90 tanB2) (* 45 tanB2 tanB2)) yN yN yN yN yN yN) 360.0)) V V tanB 0.5))      <br />       L    (+ L0 (/ (+ (- yN (/ (* (+ 1 (* 2 tanB2) ng2) yN yN yN) 6.0 )) (/ (* (+ 5 (* 28 tanB2) (* 24 tanB2 tanB2) (* 6 ng2) (* 8 ng2 tanB2)) yN yN yN yN yN) 120.0)) cosB))    <br />   )<br />   (list (Rad2Dms B) (Rad2Dms L))<br /> )<br /> ;;;<br /> ;;;cadx,cady转BL<br /> ;;;输入参数 <br /> ;;;;pt为点位cad点坐标,<br /> ;;;L0为中央经线，单位为弧度<br /> ;;;prjType取值为0:北京54坐标系,1:西安80坐标系，2：CGCS2000坐标系<br /> ;;;输出经纬度B,L表，单位为十进制<br /> (defun PrjPoint:xy2BL2(pt L0 prjType / a f e2 e12 A1 A2 A3 A4 A5 A6 A7 sinB cosB tanB tanB2 N ng2 V yN preB0 B0 eta x y )<br />   (cond <br />     ((= 0 prjType) (mapcar 'set (list 'a 'f 'e2 'e12 'A1 'A2 'A3 'A4 'A5 'A6 'A7) (PrjPoint_Krasovsky)))<br />     ((= 1 prjType) (mapcar 'set (list 'a 'f 'e2 'e12 'A1 'A2 'A3 'A4 'A5 'A6 'A7) (PrjPoint_IUGG1975)))<br />     ((= 2 prjType) (mapcar 'set (list 'a 'f 'e2 'e12 'A1 'A2 'A3 'A4 'A5 'A6 'A7) (PrjPoint_2000)))<br />     (T (alert "未知prjType参数值")(exit))<br />   )<br />   (setq   x    (cadr pt)<br />       y    (- (car pt) 500000)<br />       B0   (/ x A1)<br />       eta  1<br />   )  <br />   (while (> eta  0.000000000048)<br />     (setq  preB0  B0<br />         B0   (/ (- x (+ (* A2 (sin (* 2 B0))) (* A3 (sin (* 4 B0))) (* A4 (sin (* 6 B0))) (* A5 (sin (* 8 B0))) (* A6 (sin (* 10 B0))) (* A7 (sin (* 12 B0))))) A1)<br />         eta (abs (- B0 preB0))<br />     )  <br />   )  <br />   (setq   sinB  (sin B0)<br />       cosB   (cos B0)<br />       tanB    (/ (sin B0) (cos B0))<br />       tanB2   (* tanB tanB) <br />       N      (/ a (sqrt (- 1 (* e2 sinB sinB))))<br />       ng2      (/ (* cosB cosB e2) (- 1 e2))<br />       V    (sqrt (+ 1 ng2))<br />       yN    (/ y N)    <br />       B    (- B0 (* (+ (- (* yN yN) (/ (* (- (+ 5 (* 3 tanB2) ng2) (* 9 ng2 tanB2)) yN yN yN yN) 12.0)) (/ (* (+ 61 (* 90 tanB2) (* 45 tanB2 tanB2)) yN yN yN yN yN yN) 360.0)) V V tanB 0.5))      <br />       L    (+ L0 (/ (+ (- yN (/ (* (+ 1 (* 2 tanB2) ng2) yN yN yN) 6.0 )) (/ (* (+ 5 (* 28 tanB2) (* 24 tanB2 tanB2) (* 6 ng2) (* 8 ng2 tanB2)) yN yN yN yN yN) 120.0)) cosB))    <br />   )<br />   (list (Rad2Degree L) (Rad2Degree B) )<br /> )<br /> <br /> ;;;;;;;;;;;;;;;;;;;;;;;;;;;<br /> ;;;;;;;;;;;;;;;<br /> <br /> (defun vxs(e / p a b n ob q et d d1 en et)<br />     (setq a(entget e)ob(vlax-ename->vla-object e)et(cdr(assoc 0 a))n 0 p nil d nil)<br />     (cond((="LWPOLYLINE"et)<br />     (repeat(length a)(setq b (nth n a) n (+ n 1))<br />       (if (= 10 (car b))(progn<br />         (setq q(list (cadr b) (caddr b))d1(vlax-curve-getDistAtPoint ob q))<br />         (if p (if (not(member d1 d)) (setq p (append p (list q))d (append d (list d1))))<br />           (setq p (list q)))))))<br />    ((="POLYLINE"et)<br />     (SETQ EN (ENTGET (SETQ E (ENTNEXT E))))<br />     (WHILE (/= (CDR (ASSOC 0 EN)) "SEQEND")<br />       (SETQ q (CDR (ASSOC 10 EN))d1(vlax-curve-getDistAtPoint ob q)q(reverse(cdr(reverse q))))<br />       (if p(if (not(member d1 d)) (setq p (append p (list q))d (append d (list d1))))(setq p(list q)))<br />       (SETQ EN (ENTGET (SETQ E (ENTNEXT E)))))<br />     (setq p(reverse p))))P)<br /> <br /> <br /> ;;;;;;;;;;;;;;;;;;;<br /> (defun zbzh ( pp aa kk /   xx yy x0 y0 )<br /> <br /> <br /> (setq xx (cadr pp) yy  (car pp) )<br /> <br /> (setq x0   (* (cos aa)  (- (* xx kk)    (* (/ (sin aa) (cos aa)) (* kk  yy) )              )  )     )<br /> <br /> ;<br /> <br /> (setq y0 (+  (/ (* kk  yy) (cos aa))   (* (/ (sin aa) (cos aa)) x0 )      ))<br />   <br />   (list (+ y0 (car syd))  (+ x0 (cadr syd))  )<br /> <br />   )<br /> ;3、点表生成多段线<br /> (defun makepl (lst / pt)<br /> (entmake (append    (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(8 . "ctpzx") (cons 90 (length lst)) (cons 70 129))<br />       (mapcar '(lambda (pt)(cons 10 pt)) lst ))<br />   ) )<br /> ;;;;;;<br /> <br /> (defun c:dflw-bl2000 ( / p l0 zb jwd syd aa kk xzb  lll);;;地方坐标系或者自定义坐标根据4参数多段线转经纬度文件TXT，经纬度为10进制，可以复制到KML文件用<br /> (alert (strcat "地方坐标系或者自定义坐标根据4参数多段线转经纬度文件TXT，经纬度为10进制，可以复制到KML文件用\n"  "可以将手薄里面参与求控制点的WGS84经纬度换算成坐标\n" "然后用COORD笑脸软件求地方坐标--》WGS84坐标的4参数抄下来用"))<br />   (vl-load-com)<br /> (setq l0 (getreal "\n请输入中央子午线经度dd.mmss:"))<br /> (setq p (car(entsel "\n请选择地方坐标系或者自定义坐标多段线：")))<br /> <br /> ;(setq pp '(62295.5790 17258.584))<br /> <br /> (setq syd'(454891.370478 2529629.687669 )) ;4参数x y位移人工输入<br /> <br /> (setq aa (Dms2Rad 0.0047650491))   ;4参数旋转参数人工输入dd.mmss<br /> (setq kk 1.00000515799711)      ;4参数缩放比列因子人工输入<br />     (setq zb (vxs p))<br /> (setq lll '())<br /> (foreach y zb<br />     (setq lll (zbzh y aa kk))<br />     (setq xzb (cons lll xzb))<br />   )<br />   (makepl xzb)<br /> (setq ffn (getfiled "选取/建立数据导出10进制经纬度文件" "" "txt" 1))<br />   (setq ff (open ffn "w")) <br /> (foreach x xzb<br /> (setq jwd (PrjPoint:xy2BL2 x (Dms2Rad l0) 2))<br /> <br /> (write-line (strcat (rtos (car jwd)2 9)","(rtos (cadr jwd)2 9)) ff)<br /> <br />   )<br /> (close ff)<br />        )

流氓兔

牛逼的哥们，每次都是好代码

yshf

谢谢分享

w379106181

谢谢分享啊
谢谢分享啊

xujinhua

厉害，正需要转经纬度