导入kml画图 kml2cad

wzg356 · 发表于 2020-10-30 13:43:12

本帖最后由 wzg356 于 2022-3-17 15:05 编辑

此贴已包含在http://bbs.mjtd.com/forum.php?mo ... amp;_dsign=9ba1c0d7
请移步

kml文件最好为制式生成的
点标记-写点名文字
其他的标记划线
WGS84/国家2000椭球----两个椭球体参数相当，可实质互用
高斯投影转换
中央经线输入3/6整数-自动计算3度带/6度带的经线度数，其他正整数为实质输入的中央经线度数
使用2年了基本没发现问题

树櫴希德 · 发表于 2021-6-21 14:36:36

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

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

wzg356 · 发表于 2020-11-6 15:12:01

松树石头哥发表于 2020-11-6 10:35
请楼主说明如何使用！谢谢！！！！！

就是把kml文件的经纬度坐标转换为直角坐标并在cad画出来
kml文件是谷歌地球的文件，记录点、线、面等坐标信息

运行命令kml2cad,选择kml文件后指定中央经线（十进制度数）就行了

要有点经纬度坐标/直角地理坐标 /投影的基本概念

999999 · 发表于 2020-11-1 13:54:48

发现了一个好的东西，谢谢楼主分享，先收藏起来

C929 · 发表于 2020-11-3 19:11:19

怎么使用呢？

依然小小鸟 · 发表于 2020-11-4 08:42:52

怎么使用呢

nxchenjk · 发表于 2020-11-4 08:50:22

好东西，谢谢楼主分享。

904772207 · 发表于 2020-11-5 12:16:35

这么简单的东西也要收费？

松树石头哥 · 发表于 2020-11-6 10:35:30

请楼主说明如何使用！谢谢！！！！！

wzg356 · 发表于 2020-11-11 14:26:20

904772207 发表于 2020-11-5 12:16
这么简单的东西也要收费？

你也嗮一个看看

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

[源码] 导入kml画图 kml2cad

本帖子中包含更多资源