桥纵断面.lsp

画桥址断面的lisp源代码

;;桥梁勘测常用程序汇
(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" "经纬距"  "")
;(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输入基点坐标:"))
(setq h (getreal "\n输入字体高度:"))
(setq h1 (getint "\n输入经纬距离:"))
(while (null p0zb)
	(setq p0zb (getpoint "\n输入基点坐标:"))
);;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\需要标注经纬距吗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" "经纬距"  "")
;(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输入经纬距离:"))
(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" "经纬距"  "")
;(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输入经纬距离:"))
(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)
)
;;;定义坐标原点的程序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)坐标值:"))
(setq ps1 (getreal "\n输入N(x)坐标值:"))
(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 选择数值:"))
(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定义选择点为坐标原点
(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 "水文断面位置")
  )
;;=======标注坡度=============
(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-线路右侧:"))
  (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 "线路右侧"))
    );;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-线路左侧:"))
  (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 "线路左侧"))
    );;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-线路右侧:"))
  (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
  
  )
;;
;;
;;
;;
;;

;;;;============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)；内图
  (command "color" 9)
  (command "linetype" "s" "dot" "")
  ;;;;;;;;;;;;;
  (setq p0y (nth 1 p0))
  (setq t1 (+ p0y 10))
  ;;水平线细线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))
    );;最下层水平细
  (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))
    )
  ;;;;水平线细线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)