通用Lisp函数【经纬度到坐标的转换】经纬度2坐标.lsp

在网上找到的,也许可以对测友有一些我帮助!

;;;测试:
(defun c:tt ()
  ;;算法一
  (setq	tmp (BL->xy54 1.9896753472735
		      0.6096519434215
		      1.9638390350254
	    )
  )
  (princ "n算法一结果:")
  (princ (rtos (car tmp) 2 10))
  (princ "t")
  (princ (rtos(cadr tmp) 2  10))
 ;;算法二
  (setq	tmp (BL->xy5402 1.9896753472735
		      0.6096519434215
		      1.9638390350254
	    )
  )
  (princ "n算法二结果:")
  (princ (rtos (car tmp) 2 10))
  (princ "t")
  (princ (rtos(cadr tmp) 2  10))

  (princ)
)

;;;=================================================================*
;;;功能:经纬度转换为北京54坐标(算法一)                           *
;;;参数:L0 ----投影带中央子午线。弧度单位                          *
;;;      L  ----经度。弧度单位                                      *
;;;      B  ----纬度。弧度单位                                      *
;;;日期:zml84 于 2012-04-20                                        *
(defun BL->xy54	(L0 B L / A1 A2 A3 A4 a f)
  ;;设置常数(均为实数)
  (setq	A1 111134.8611
	A2 -16036.4803
	A3 16.8281
	A4 -0.022
	a  6378245.0
	f  298.3
  )
  (BL->xy L0 B L A1 A2 A3 A4 a f)
)
;;;=================================================================*
;;;功能:经纬度转换为西安80坐标(算法一)                           *
;;;参数:L0 ----投影带中央子午线。弧度单位                          *
;;;      L  ----经度。弧度单位                                      *
;;;      B  ----纬度。弧度单位                                      *
;;;日期:zml84 于 2012-04-23                                        *
(defun BL->xy80	(L0 B L / A1 A2 A3 A4 a f)
  ;;设置常数(均为实数)
  (setq	A1 111133.0047
	A2 -16038.5282
	A3 16.8326
	A4 -0.022
	a  6378140.0
	f  298.257
  )
  (BL->xy L0 B L A1 A2 A3 A4 a f)
)
;;;=================================================================*
;;;=================================================================*
;;;通用,经纬度转坐标                                               *
;;;      给定不同参数,可适用于不同坐标系。                         *
(defun BL->xy (L0 B L A1 A2 A3 A4 a f /	COSB E12 E2 M M2 N NG2 SINB T2
	       TT X Y)
  (setq
    e2	(- 1 (* (/ (- f 1) f) (/ (- f 1) f)))
    e12	(- (* (/ f (- f 1)) (/ f (- f 1))) 1)
  )
  (setq
    sinB (Sin B)
    cosB (Cos B)
    tt	 (Tan B)
    t2	 (* tt tt)
  )
  (setq
    n	(/ a (Sqrt (- 1 (* e2 sinB sinB))))
    m	(* cosB (- L L0))
    m2	(* m m)
    ng2	(/ (* cosB cosB e2) (- 1 e2))
  )
  ;;计算x
  (setq
    X (+ (/ (* A1 B 180.0) PI)
	 (* A2 (Sin (* 2 B)))
	 (* A3 (Sin (* 4 B)))
	 (* A4 (Sin (* 6 B)))
      )
    X (+ X
	 (* n
	    tt
	    (* (+ 0.5
		  (* (+	(/ (+ 5 (- t2) (* 9 ng2) (* 4 ng2 ng2)) 24.0)
			(/ (* (+ 61 (* -58 t2) (* t2 t2)) m2) 720.0)
		     )
		     m2
		  )
	       )
	       m2
	    )
	 )
      )
  )
  ;;计算y
  (setq
     Y (* n
	 m
	 (+ 1
	    (* m2
	       (+
		 (/ (+ 1 (- t2) ng2) 6.0)
		 (/ (* m2
		       (+ 5
			  (* -18 t2)
			  (* t2 t2)
			  (* 14 ng2)
			  (* -58 ng2 t2)
		       )
		    )
		    120.0
		 )
	       )
	    )
	 )
      )
    Y (+ Y 500000.0)
  )
  ;;返回
  (list x y)
)
;;;=================================================================*
;;;=================================================================*
;;;功能:经纬度转换为北京54坐标(算法二)                           *
;;;参数:L0 ----投影带中央子午线。弧度单位                          *
;;;      L  ----经度。弧度单位                                      *
;;;      B  ----纬度。弧度单位                                      *
;;;日期:zml84 于 2011-12-28                                        *
(defun BL->xy5402 (L0 B L / BB I2 J2 K2 L2 LL M2 N2 O2 P2 Q2 R2 X Y)
  (setq	BB B
	LL (- L L0)
  )
  (setq	I2 (TAN B)
	J2 (COS B)
  )
  (setq	K2 (* 0.006738525415 J2 J2)
	L2 (* I2 I2)
	M2 (+ 1 K2)
	N2 (/ 6399698.9018 (SQRT M2))
	O2 (* LL LL J2 J2)
	P2 (* I2 J2)
	Q2 (* P2 P2)
	R2 (+ 32005.78006 (* Q2 (+ 133.92133 (* Q2 0.7031))))
	X  (+ (* 6367558.49686 BB)
	      (* -1 P2 J2 R2)
	      (* (+ 1
		    (* (+ (*
			    (+ (* (- L2 58) L2) 61)
			    O2
			    (/ 1.0 30)
			  )
			  (* (+ (* 4 K2) 5) M2)
			  (- L2)

		       )
		       O2
		       (/ 1.0 12)
		    )
		 )
		 N2
		 I2
		 O2
		 0.5
	      )
	   )
	Y  (+ 500000
	      (* (+
		   (*
		     (+	(*
			  (+ (* (- L2 18) L2)
			     (* -1 (- (* 58 L2) 14) K2)
			     5
			  )
			  O2
			  (/ 1.0 20)
			)
			M2
			(- L2)
		     )
		     O2
		     (/ 1.0 6)
		   )
		   1
		 )
		 N2
		 LL
		 J2
	      )
	   )
  )
  ;;返回
  (list x y)
)