;;橋梁勘測常用程序匯
(defun qz (x n / s1 m)
(setq m (/ n 2))
(if (>= x 0)(setq x (+ x m)) (setq x (- x m)))
(setq s1 (/ x n))
(setq s1 (fix s1))
(setq x (* s1 n))
)
(defun c:cx (/ h h1 bl p0 p0zb p dp pd ps l1 l2 l3 p1 p2 p3 p4 s1 s2)
(command "layer" "m" "經(jīng)緯距"  "")
;(command "style" "xsyst" "宋體" 0 0.75 0 "n" "n" "n")
(command "style" "xsy" "italc1,fs" 0 0.75 0 "n" "n" "n")
(command "linetype" "s" "continuous" "")
(setvar "blipmode" 0)
(setq bl (getreal "\n比例:"))
(setq bl (* bl 0.1))
(setq n (* 100 bl))
(setvar "osmode" 33)
(setq p0 (getpoint "\n選擇基點:"))
(setvar "osmode" 0)
(setvar "angbase" 0)
(setq p0zb (getpoint "\n輸入基點坐標(biāo):"))
(setq h (getreal "\n輸入字體高度:"))
(setq h1 (getint "\n輸入經(jīng)緯距離:"))
(while (null p0zb)
	(setq p0zb (getpoint "\n輸入基點坐標(biāo):"))
);;while
(setq p t)
(while p
;;(setvar "osmode" 33)
(setq p (getpoint "\n輸入點:"))
(setvar "osmode" 0)
(if (null p) (setq p nil)
	(progn
	(setq dp (mapcar '- p p0))
	(setq l1 (nth 0 dp) l2 (nth 1 dp) l3 (nth 2 dp))
	(setq l1 (qz l1 h1) l2 (qz l2 h1))
	(setq dp (list l1 l2 l3))
	(setq pd (mapcar '+ p0 dp))
	(setq dp (mapcar '* dp (list bl bl 0)))
	(setq ps (mapcar '+ p0zb dp))
;;;;
	(setq p1 (mapcar '+ pd '(5 0 0)))
	(setq p2 (mapcar '+ pd '(-5 0 0)))
	(setq p3 (mapcar '+ pd '(0 5 0)))
	(setq p4 (mapcar '+ pd '(0 -5 0)))
	(command "color" 7)
	(command "line" p1 p2 "")
	(command "line" p3 p4 "")
	(setq s1 (rtos (nth 0 ps) 2 0))
	(setq s2 (rtos (nth 1 ps) 2 0))
	;(setq t (getstring "n\需要標(biāo)注經(jīng)緯距嗎y/n"))
	;(setq t (strcase t))
	;(if (/= t "N") (progn
	(command "color" 7)
	(command "text" "bl" pd h 270 (strcat "E" s1))
	(command "text" "br" pd h 0   (strcat "N" s2))
	;));;if
	);;progn
);;if
);;while
);;

;;;
;;;
(defun c:cx1 (/ h bl p0 p0zb p dp pd ps l1 l2 l3 p1 p2 p3 p4 s1 s2)
(command "layer" "m" "經(jīng)緯距"  "")
;(command "style" "xsyst" "宋體" 0 0.75 0 "n" "n" "n")
(command "style" "xsy" "italc1,fs" 0 0.75 0 "n" "n" "n")
(command "linetype" "s" "continuous" "")
;(setq bl (getreal "\n比例:"))
(setq bl 1)
(setq n (* 100 bl))
(setvar "osmode" 33)
(setq p0 (getpoint "\n選擇基點:"))
(setq h1 (getint "\n輸入經(jīng)緯距離:"))
(setvar "osmode" 0)
(setvar "angbase" 0)
(setq p t)
(while p
(setq p (getpoint "\n輸入點:"))
(setvar "osmode" 0)
(if (null p) (setq p nil)
	(progn
	(setq dp (mapcar '- p p0))
	(setq l1 (nth 0 dp) l2 (nth 1 dp) l3 (nth 2 dp))
	(setq l1 (qz l1 h1) l2 (qz l2 h1))
	(setq dp (list l1 l2 l3))
	(setq pd (mapcar '+ p0 dp))
	(setq dp (mapcar '* dp (list bl bl 0)))
	(setq ps (mapcar '+ p0zb dp))
;;;;
	(setq p1 (mapcar '+ pd '(2.5 0 0)))
	(setq p2 (mapcar '+ pd '(-2.5 0 0)))
	(setq p3 (mapcar '+ pd '(0 2.5 0)))
	(setq p4 (mapcar '+ pd '(0 -2.5 0)))
	(command "color" 7)
	(command "line" p1 p2 "")
	(command "line" p3 p4 "")
	);;progn
);;if
);;while
);;

(defun c:cx2 (/ h h1 bl p0 p0zb p dp pd ps l1 l2 l3 p1 p2 p3 p4 s1 s2)
(command "layer" "m" "經(jīng)緯距"  "")
;(command "style" "xsy" "italc1,fs" 0 0.75 0 "n" "n" "n")
(command "linetype" "s" "continuous" "")
(setvar "blipmode" 0)
(setvar "angbase" 0)
;(setq bl (getreal "\n比例:"))
(setq bl 10)
(setq bl (* bl 0.1))
(setq n (* 100 bl))
(setvar "osmode" 0)
(setvar "angbase" 0)
;(setq h (getreal "\n輸入字體高度:"))
;(setq h1 (getint "\n輸入經(jīng)緯距離:"))
(setq h 1.5 h1 50)
(setq p t)
(while p
(setq p (getpoint "\n輸入點:"))
(if (null p) (setq p nil)
	(progn
	(setq l1 (nth 0 p) l2 (nth 1 p) l3 (nth 2 p))
	(setq l1 (qz l1 h1) l2 (qz l2 h1))
	(setq p (list l1 l2 l3))
	(setq p1 (mapcar '+ p '(5 0 0)))
	(setq p2 (mapcar '+ p '(-5 0 0)))
	(setq p3 (mapcar '+ p '(0 5 0)))
	(setq p4 (mapcar '+ p '(0 -5 0)))
	(command "color" 7)
	(command "line" p1 p2 "")
	(command "line" p3 p4 "")
	(setq s1 (rtos (nth 0 p) 2 0))
	(setq s2 (rtos (nth 1 p) 2 0))
	(command "text" "bl" p h 270 (strcat "E" s1))
	(command "text" "br" p h 0   (strcat "N" s2))
	;));;if
	);;progn
);;if
);;while
);;

;;;=============sc================
(defun c:sc (/ p1 p2 st s s1 bl)
(setvar "osmode" 33)
(setq p1 (getpoint "\nfirst point:"))
(setq p2 (getpoint "\nsecond point:"))
(setvar "osmode" 0)
(princ "選擇物體:")
(setq st (ssget))
(setq s (distance p1 p2))
(setq s1 (getreal "\n輸入欲放大到的距離："))
(setq bl (/ s1 s))
(command "scale" st "" p1 bl)
)
;;;定義坐標(biāo)原點的程序ucso、ucs1、ucs2
(defun c:ucs1 (/ p p0 ps ps1 pls)
(setvar "osmode" 33)
(setq p (getpoint "\n 選擇點:"))
(setvar "osmode" 0)
(setq ps (getreal "\n輸入E(y)坐標(biāo)值:"))
(setq ps1 (getreal "\n輸入N(x)坐標(biāo)值:"))
(setq p0 (list ps ps1 0))
(setq ps (- 0 ps) ps1 (- 0 ps1))
(setq pls (list ps ps1 0))
(command "ucs" "o" p)
(command "ucs" "o" pls)
)
;;;ucs2
(defun c:ucs2 (/ p ps pls)
(setvar "osmode" 33)
(setq p (getpoint "\n 選擇點:"))
(setq ps (entsel "\n 選擇數(shù)值:"))
(setq ps (nth 0 ps))
(setq ps (entget ps))
(setq ps (assoc 1 ps))
(setq ps (cdr ps))
(setq ps (read ps))
(setq ps (- 0 ps))
(setvar "osmode" 0)
(setq pls (list 0 ps 0))
(command "ucs" "o" p)
(command "ucs" "o" pls)
)
;;;;ucso定義選擇點為坐標(biāo)原點
(defun c:ucso (/ p ps pls)
(setvar "osmode" 33)
(setq p (getpoint "\n 選擇點:"))
(setvar "osmode" 0)
(setq pls (list 0 0 0))
(command "ucs" "o" p)
(command "ucs" "o" pls)
)
;;
;;;;;
;;;
;;;==========swdm====================
(defun c:swdm (/ p0 p1 p2)
  (setvar "osmode" 33)
  (command "color" 4)
  (command "linetype" "s" "continuous" "")
  (setq p0 (getpoint "\n輸入斷面位置:"))
  (setq p1 (mapcar '+ p0 '(0 20 0)))
  (setq p2 (mapcar '+ p1 '(0 2 0)))
  (command "line" p0 p1 "")
  (command "color" 7)
  (setvar "osmode" 0)
  (command "text" "bc" p2 4 0 "水文斷面位置")
  )
;;=======標(biāo)注坡度=============
(defun c:pd (/ s p0 p1 pt p2)
  (setvar "osmode" 0)
  (command "color" 4)
  (command "linetype" "s" "continuous" "")
  (setq p0 (getpoint "\n輸入起點:"))
  (setq s (getreal "\n輸入坡度:"))
  (setq s (rtos s 2 2))
  (setq p1 (mapcar '+ p0 '(20 0 0)))
  (setq pt (mapcar '+ p0 '(10 1 0)))
  (setq p2 (mapcar '+ p1 '(-5 0.5 0)))
  (command "pline" p0 p1 p2 "")
  (command "color" 7)
  (command "text" "bc" pt 4 0 (strcat s "‰"))
  )
;;
(defun c:pd1 (/ pd1 pd2 jd p s p0 p1 pt p2)
  (setvar "osmode" 512)
  (command "color" 4)
  (command "linetype" "s" "continuous" "")
  (setq pd1 (getpoint "\n輸入第一點:"))
  (setq pd2 (getpoint "\n輸入第二點:"))
  (setq jd (angle pd1 pd2))
  (setq jd2 (- jd 0.05))
  (setq jd1 (* jd 57.29577951))
  (setvar "osmode" 0)
  (setq p (mapcar '- pd2 pd1))
  (setq s (/ (cadr p) (car p)))
  (setq s (* s 1000))
  (setq s (rtos s 2 2))
  (setq p0 (getpoint "\n輸入起點:"))
  (setq p1 (polar p0 jd 20))
  (setq pt (polar p0 jd 10))
  (setq p2 (polar p0 jd2 12))
  (command "pline" p0 p1 p2 "")
  (command "color" 7)
  (command "text" "bc" pt 4 jd1 (strcat s "‰"))
  )
;;;;;;;;
(defun c:fxy (/ pd1 pd2 jd p s p0 p1 pt p2)
  (setvar "osmode" 512)
  (setvar "angbase" 0)
  (command "color" 4)
  (command "linetype" "s" "continuous" "")
  (setq pd1 (getpoint "\n輸入第一點:"))
  (setq pd2 (getpoint "\n輸入第二點:"))
  (setq jd (angle pd1 pd2))
  (setq jd2 (- jd 0.05))
  (setq jd1 (* jd 57.29577951))
  (setvar "osmode" 0)
  (setq p0 (getpoint "\n輸入起點:"))
  (setq p1 (polar p0 jd 20))
  (setq pt (polar p0 jd 10))
  (setq p2 (polar p0 jd2 12))
  (command "pline" p0 p1 p2 "")
  (command "color" 7)
  (initget 7 "1 2 3 4")
  (setq dw (getkword "選擇 1-出口 2-入口 3- 井口 4-線路右側(cè):"))
  (cond
    ((= dw "1") (command "text" "bc" pt 5 jd1 "出  口"))
    ((= dw "2") (command "text" "bc" pt 5 jd1 "入  口"))
    ((= dw "3") (command "text" "bc" pt 5 jd1 "井  口"))
    ((= dw "4") (command "text" "bc" pt 5 jd1 "線路右側(cè)"))
    );;cond
  ;(command "text" "bc" pt 4 jd1 dw)
  )
;;
(defun c:fxz (/ pd1 pd2 jd p s p0 p1 pt p2)
  (setvar "osmode" 512)
  (setvar "angbase" 0)
  (command "color" 4)
  (command "linetype" "s" "continuous" "")
  (setq pd1 (getpoint "\n輸入第一點:"))
  (setq pd2 (getpoint "\n輸入第二點:"))
  (setq jd (angle pd1 pd2))
  (setq jd2 (+ jd 0.05))
  (setq jd1 (* jd 57.29577951))
  (setq jd1 (+ 180 jd1))
  (setvar "osmode" 0)
  (setq p0 (getpoint "\n輸入起點:"))
  (setq p1 (polar p0 jd 20))
  (setq pt (polar p0 jd 10))
  (setq p2 (polar p0 jd2 12))
  (command "pline" p0 p1 p2 "")
  (command "color" 7)
  (initget 7 "1 2 3 4")
  (setq dw (getkword "選擇 1-出口 2-入口 3- 重慶 4-線路左側(cè):"))
  (cond
    ((= dw "1") (command "text" "bc" pt 5 jd1 "出  口"))
    ((= dw "2") (command "text" "bc" pt 5 jd1 "入  口"))
    ((= dw "3") (command "text" "bc" pt 5 jd1 "重慶"))
    ((= dw "4") (command "text" "bc" pt 5 jd1 "線路左側(cè)"))
    );;cond
  ;(command "text" "bc" pt 4 jd1 dw)
  )

(defun c:tz (/ p0 p1 pt p2)
  (setvar "osmode" 0)
  (command "color" 4)
  (command "linetype" "s" "continuous" "")
  (setq p0 (getpoint "\n輸入起點:"))
  (setq p1 (mapcar '+ p0 '(-20 0 0)))
  (setq pt (mapcar '+ p0 '(-10 1 0)))
  (setq p2 (mapcar '+ p1 '(8 -1 0)))
  (command "pline" p0 p1 p2 "")
  (command "color" 7)
  (initget 7 "1 2 3 4")
  (setq dw (getkword "選擇文字方向 1-出口 2-入口 3-遂寧 4-重慶:"))
  (cond
    ((= dw "1") (command "text" "bc" pt 5 0 "出  口"))
    ((= dw "2") (command "text" "bc" pt 5 0 "入  口"))
    ((= dw "3") (command "text" "bc" pt 5 0 "遂寧"))
    ((= dw "4") (command "text" "bc" pt 5 0 "重慶"))
    );;cond
  
  );;
;;
(defun c:ty (/ p0 p1 pt p2)
  (setvar "osmode" 0)
  (command "color" 4)
  (command "linetype" "s" "continuous" "")
  (setq p0 (getpoint "\n輸入起點:"))
  (setq p1 (mapcar '+ p0 '(20 0 0)))
  (setq pt (mapcar '+ p0 '(10 1 0)))
  (setq p2 (mapcar '+ p1 '(-8 -1 0)))
  (command "pline" p0 p1 p2 "")
  (command "color" 7)
  (initget 7 "1 2 3 4")
  (setq dw (getkword "選擇文字方向 1-出口 2-入口 3- 井口 4-線路右側(cè):"))
  (cond
    ((= dw "1") (command "text" "bc" pt 5 0 "出  口"))
    ((= dw "2") (command "text" "bc" pt 5 0 "入  口"))
    ((= dw "3") (command "text" "bc" pt 5 0 "井  口"))
    ((= dw "4") (command "text" "bc" pt 5 0 "線路右側(cè)"))
    );;cond
  
  )
;;
;;
;;
;;
;;

;;;;============xx==============
(defun c:xx ()
  (setvar "osmode" 35)
  (setvar "blipmode" 0)
  (setvar "angbase" 0)
  (setvar "angdir" 0)
  (command "style" "xsy" "italc1,fs" 0 0.75 0 "n" "n" "n")
  )
;;------------圖框程
(defun tk1 (p0 / p0x p0y pw0 pw1 pn0 pn1 t1 tx ty pd )
  (setvar "ltscale" 1)
  ;(setq p0 '(0 0))
  (setq pw0 (mapcar '+ p0 '(-25 -10)))
  (setq pw1 (mapcar '+ p0 '(760 287)))
  (command "layer" "m" "tk"  "")
  (command "linetype" "s" "continuous" "")
  (COMMAND "COLOR" 7)
  (command "rectang" pw0 pw1);外圖
  (setq pn1 (mapcar '+ p0 '(750 277)))
  (COMMAND "COLOR" 2)
  (command "rectang" p0 pn1)；內(nèi)圖
  (command "color" 9)
  (command "linetype" "s" "dot" "")
  ;;;;;;;;;;;;;
  (setq p0y (nth 1 p0))
  (setq t1 (+ p0y 10))
  ;;水平線細(xì)線begin
  (setq p0x (nth 0 p0))
  (repeat 4
    (setq tx (list p0x t1) ty (list  (+ p0x 670) t1))
    (command "line" tx ty "")
    (setq t1 (+ t1 10))
    );;最下層水平細(xì)
  (setq t1 (+ t1 10))
  (repeat 4
    (repeat 4
      (setq tx (list p0x t1) ty (list  (+ p0x 750) t1))
      (command "line" tx ty "")
      (setq t1 (+ t1 10))
      )
    (setq t1 (+ t1 10))
    )
  (repeat 2
    (setq tx (list p0x t1) ty (list  (+ p0x 750) t1))
    (command "line" tx ty "")
    (setq t1 (+ t1 10))
    )
  ;;;;水平線細(xì)線end
  ;;;
  (command "linetype" "s" "dot2" "")
  (setq  t1 (+ p0y 50))
  (command "color" 93)
  (repeat 5
    (setq tx (list p0x t1) ty (list (+ p0x 750) t1))
    (command "line" tx ty "")
    (setq t1 (+ t1 50))
    )
  ;;;;;;;水平粗線end
  ;;;;begin 豎
  (setq t1 (+ p0x 50))
  (setq n 13)
  (repeat n
    (setq tx (list t1 p0y) ty (list t1(+ p0y 277)))
    (command "line" tx ty "")
    (setq t1 (+ t1 50))
    )
  (setq tx (list t1 (+ p0y 40)) ty (list t1(+ p0y 277)))
  (command "line" tx ty "");;粗
  (command "linetype" "s" "dot" "")
  (setq t1 (+ p0x 10))
  (command "color" 9)
  (command)
  (repeat n
    (repeat 4
      (setq tx (list t1 p0y) ty (list t1(+ p0y 277)))
      (command "line" tx ty "")
      (setq t1 (+ t1 10))
      )
    (setq t1 (+ 10 t1))
    )
  (setq tx (list t1 p0y) ty (list t1(+ p0y 277)))
  (command "line" tx ty "")
  (repeat 2
    (repeat 4
      (setq tx (list t1 (+ p0y 40)) ty (list t1(+ p0y 277)))
      (command "line" tx ty "")
      (setq t1 (+ t1 10))
      )
    (setq t1 (+ 10 t1))
    )
  (command "color" 7)
  (setq pd (mapcar '+ p0 '(750 0)))
  (command "insert" "d:\\xsy\\tb" pd "" "" "")
  (command "layer" "m" "0" "")
  (command "linetype" "s" "continuous" "")
  ;(setq p0x nil p0y nil pw0 nil pw1 nil  pn0 nil  pn1 nil  t1 nil)
  ;(setq tx nil  ty nil pc nil)
  )
;;;end of file
;;;-----------------------------
;;;;-----------------------------
;;;程序1(pc)
(defun pc (p0 / n m i s1 p01)
  (setq n (strlen p0) m 1 i 1 pl ())
  (while (< i n)
    (setq s1 (substr p0 i 1))
    (if (or (= s1 " ") (= s1 ","))
      (progn
	(setq p01 (substR P0 m (- i m)))
	(setq p01 (read p01))
	(if p01 (setq pl (cons p01 pl)))
	(setq m (+ i 1))
	);;progn
      );;if
    (setq i (+ i 1))
    );;;while
  (setq p01 (substR P0 m))
  (setq p01 (read p01))
  (if p01 (setq pl (cons p01 pl)))
  (setq pl (reverse pl))
  );;;end--------------------------------------

;;;程序2(pcc)