桥纵断面.lsp

画桥址断面的lisp源代码

(defun pcc (p0 / n m i s1 p01 pcx)
  (setq n (strlen p0) m 1 i 1 pl ())
  (while (< i n)
    (setq s1 (substr p0 i 1))
    (if (or (= s1 " ") (= s1 "+") (= s1 ",") (= s1 "\t"))
      (progn
	(setq p01 (substR P0 m (- i m)))
	(if (read p01) (setq pl (cons p01 pl)))
	(setq m (+ i 1))
	);;progn
      );;if
    (setq i (+ i 1))
    );;;while
  (setq p01 (substR P0 m))
  (setq pcx (read p01))
  (if pcx (setq pl (cons p01 pl)))
  (setq pl (reverse pl))
  )
;;;;------------------------------
;;;;程序3(hh)
(DEFUN HH ()
  (command "style" "xsy" "italc1,fs" 0 0.75 0 "n" "n" "n")
  (SETVAR "DIMTXSTY" "XSY")
  (SETVAR "DIMTXT" 3.5)
  (SETVAR "DIMUNIT" 2)
  (SETVAR "DIMDEC" 2)
  (SETVAR "DIMSCALE" 1)
  (SETVAR "DIMEXE" 2)
  (SETVAR "DIMASZ" 2.5)
  (SETVAR "DIMCLRD" 6)
  (SETVAR "DIMCLRE" 6)
  (SETVAR "DIMCLRT" 7)
  (SETVAR "DIMTIX" 1)
  )
;;;---------------------------------------------
(DEFUN HH2 ()
  (command "style" "xsy" "italc1,fs" 0 0.75 0 "n" "n" "n")
  (SETVAR "DIMTXSTY" "XSY")
  (SETVAR "DIMTXT" 3.5)
  (SETVAR "DIMUNIT" 2)
  (SETVAR "DIMDEC" 2)
  (SETVAR "DIMSCALE" 1)
  (SETVAR "DIMLFAC" 0.2)
  (SETVAR "DIMEXE" 2)
  (SETVAR "DIMASZ" 2.5)
  (SETVAR "DIMCLRD" 6)
  (SETVAR "DIMCLRE" 6)
  (SETVAR "DIMCLRT" 7)
  (SETVAR "DIMTIX" 1)
  )
;;;;-----------------------------------------------------
(defun HH5 ()
  (command "style" "xsy" "italc1,fs" 0 0.75 0 "n" "n" "n")
  (SETVAR "DIMTXSTY" "XSY")
  (SETVAR "DIMTXT" 3.5)
  (SETVAR "DIMUNIT" 2)
  (SETVAR "DIMDEC" 2)
  (SETVAR "DIMSCALE" 1)
  (SETVAR "DIMLFAC" 0.5)
  (SETVAR "DIMEXE" 2)
  (SETVAR "DIMASZ" 2.5)
  (SETVAR "DIMCLRD" 6)
  (SETVAR "DIMCLRE" 6)
  (SETVAR "DIMCLRT" 7)
  (SETVAR "DIMTIX" 1)
  )
;;;;;---------------------------------------------------------
;;;=====================
;;;=====================
;;;;;;;;;;绘制3m
(defun cs (/ p p1 px py)
  (setq bl (getreal "\n输入比例<200、500>:"))
  (if (null bl) (setq bl 5.0))
  (setq bl (/ 10.0 bl))
  (setvar "osmode" 33)
  (setq p (getpoint "\n输入初始化的点:"))
  (setvar "osmode" 0)
  (setq p1 (nth 0 p) p2 (nth 1 p))
  (setq pp (getpoint "\n点表示的里程、标高："))
  (setq px (nth 0 pp) py (nth 1 pp))
  (setq px (* bl px) py (* bl py))
  (setq px (- px p1) py (- py p2))
  (setq pp (list px py))
  (setq bl (list bl bl))
  (mx)
  );;;
(defun mx (/ l1 l)
  (zdm)
  (setq l ())
  (foreach x tmp2 (setq l (cons (mapcar '* x bl) l)))
  (setq l1 ())
  (foreach x l (setq l1 (cons (mapcar '- x pp) l1)))
  (command "color" 6)
  (command "pline")
  (foreach x l1 (command x))
  (command)
  (setvar "celtype" "continuous")
  (command "color" 7)
  )
(defun c:3mx ()
  (setvar "cmdecho" 0)
  (command "layer" "m" "3mx"  "")
  (command "linetype" "s" "dashdot" "")
  (setq k (getint"\n 1:初始化 2:点绘3米线: "))
  (cond ((= k 1) (cs))
	((= k 2) (mx))
	)
  )
;;;;end of3mx----------3mx
;;;;;;;;;;sjx---------sjx设计线程
;;;---------------
(defun c:sjx ()
  (setvar "cmdecho" 0)
  (command "layer" "m" "sjx"  "")
  (command "linetype" "s" "continuous" "")
  (setq k (getint"\n 1:初始化 2:绘设计线: "))
  (cond ((= k 1) (cs))
	((= k 2) (mx))
	)
  )
;;;-----------------
(defun c:sjx1 (/ bl p p1 pp px n l)
  (setq bl (getreal "\n输入比例<200、500>:"))
  (if (null bl) (setq bl 5.0))
  (setq bl (/ 10.0 bl))
  (setvar "osmode" 33)
  (setq p (getpoint "\n输入初始化的点:"))
  (setvar "osmode" 0)
  (setq p1 (nth 0 p) p2 (nth 1 p))
  (setq pp (getpoint "\n点表示的里程、标高："))
  (setq px (nth 0 pp) py (nth 1 pp))
  (setq px (* bl px) py (* bl py))
  (setq px (- px p1) py (- py p2))
  (setq n (getint "\n输入变坡点个数:"))
  (setq l ())
  (repeat n
    (setq p (getpoint "\n输入变坡点的里程、标高:"))
    (setq p (list (- (* bl (nth 0 p)) px) (- (* bl (nth 1 p)) py)))
    (setq l (cons p l))
    )
  (command "pline")
  (foreach x l (command x))
  (command)
  )
;;;;end of sjx1----------sjx1

;;===================================
;;===================================
;;;
;;--------------------
;;;;标注程
(defun c:bz2 (/ P1 p2 S pn)
  ;;(command "style" "xsy" "italc1,fs" 0 0.75 0 "" "" "")
  (setvar "osmode" 33)
  (setq p1 (getpoint "\n 选择标注点： "))
  (setq p2 (getpoint "\n 选择基点："))
  (setvar "osmode" 0)
  (setq pn (getreal "\n 输入基点标高:"))
  (setq s (- (nth 1 p1) (nth 1 p2)))
  (setq s (/ s 5.0))
  (setq s (+ pn s))
  (setq p01 (mapcar '+ p1 '(1.5 4)))
  (setq p02 (mapcar '+ p1 '(-1.5 4)))
  (command "pline" p1 p01 p02 p1 "")
  (setq p1 (polar p1 (* 0.5 pi) 7))
  (command "text" "m" p1 4 0 (rtos s 2 2))
  )
;;;---------------------------------------
(defun c:bz5 (/ P1 S p2 pn)
  ;;(command "style" "xsy" "宋体" 0 0.75 0 "" "" "")
  (setvar "osmode" 33)
  (setq p1 (getpoint "\n 选择标注点： "))
  (setq p2 (getpoint "\n 选择基点："))
  (setvar "osmode" 0)
  (setq pn (getreal "\n 输入基点标高:"))
  (setq s (- (nth 1 p1) (nth 1 p2)))
  (setq s (/ s 2.0))
  (setq s (+ pn s))
  (setq p01 (mapcar '+ p1 '(1.5 4)))
  (setq p02 (mapcar '+ p1 '(-1.5 4)))
  (command "pline" p1 p01 p02 p1 "")
  (setq p1 (polar p1 (* 0.5 pi) 7))
  (command "text" "m" p1 4 0 (rtos s 2 2))
  )
;;;end   bz-------------bz
;;;
(defun c:bzd (/ p1 p2 p3 p4 p01 p02 s)
  ;;(command "style" "xsy" "italc1,fs" 0 0.75 0 "n" "n" "n")
  (setq p1 t)
  (while p1
    (setvar "osmode" 33)
    (setq p1 (getpoint "\n 选择标注点： "))
    (if (null p1) (setq p1 nil)
      (progn
	(setvar "osmode" 0)
	(setq s (getreal "\n 输入标注点标高数据:"))
	(command "color" 7)
	(setq p01 (mapcar '+ p1 '(1 2)))
	(setq p02 (mapcar '+ p1 '(-1 2)))
	(command "pline" p1 p01 p02 p1 "")
	(setq p2 (mapcar '+ p1 '(2 1)))
	(setq p3 (mapcar '+ p1 '(-2 1)))
	(setq p4 (mapcar '+ p1 '(0 4.5)))
	(initget 7 "1 2 3")
	(setq dw (getkword "选择文字方向 1-左侧 2-右侧 3-上方:"))
	(cond
	  ((= dw "1") (command "text" "br" p3 2.75 0 (rtos s 2 2)))
	  ((= dw "2") (command "text" "bl" p2 2.75 0 (rtos s 2 2)))
	  ((= dw "3") (command "text" "bc" p4 2.75 (rtos s 2 2)))
	  );;cond
	);progn
      ));;if,while
  );;end
;;;
(defun c:bz (/ pjd p1 p2 p3 bl pn s p01 p02 dw)
  ;;(command "style" "xsy" "italc1,fs" 0 0.75 0 "n" "n" "n")
  (setvar "osmode" 33)
  (setq pjd (getpoint "\n 选择基点："))
  (print)
  (setq bl (getreal "\输入比例："))
  (setq bl (/ 10 bl))
  (command "color" 7)
  (setq pn (getreal "\n 输入基点标高数据:"))
  (setq p1 t)
  (while p1
    (setvar "osmode" 33)
    (setq p1 (getpoint "\n 选择标注点： "))
    (if (null p1) (setq p1 nil)
      (progn
	(setq s (- (nth 1 p1) (nth 1 pjd)))
	(setq s (/ s bl))
	(setq s (+ pn s))
	(setvar "osmode" 0)
	(setq p01 (mapcar '+ p1 '(1 2)))
	(setq p02 (mapcar '+ p1 '(-1 2)))
	(command "pline" p1 p01 p02 p1 "")
	(setq p2 (mapcar '+ p1 '(2 1)))
	(setq p3 (mapcar '+ p1 '(-2 1)))
	(setq p4 (mapcar '+ p1 '(0 4.5)))
	(initget 7 "1 2 3")
	(setq dw (getkword "选择文字方向1-左侧 2-右侧 3-上方:"))
	(cond
	  ((= dw "1") (command "text" "br" p3 2.75 0 (rtos s 2 2)))
	  ((= dw "2") (command "text" "bl" p2 2.75 0 (rtos s 2 2)))
	  ((= dw "3") (command "text" "bc" p4 2.75 90 (rtos s 2 2)))
	  );;cond
	);;progn
      );if
    );;while
  );;end
;;;;结束标注程序，标高标注程序共为4个，bz2、bz5、bzd、bz
;;;begin 里程标注程
(defun c:lc1 (/ bl p p1 pd pt)
  (setq bl (getreal "\n绘图比例:"))
  (if (null bl) (setq bl 5.0))
  (setq bl (/ 10 bl))
  (setvar "osmode" 33)
  (SETQ P (getpoint "\n捕捉点:"))
  (setq p1 (getreal "\n输入捕捉点里程:"))
  (setq pd t)
  (while pd
    (setq pd (getpoint "\n孔跨点:"))
    (if (null pd) (setq pd nil)
      (progn
	(setvar "osmode" 0)
	(setq pt (- (car pd) (car p)))
	(setq pt (/ pt bl))
	(setq pt (+ pt p1))
	(if (< pt 0) (setq pt (+ pt 1000)))
	(setq pt (rem pt 1000))
	(cond
	  ((< pt 0)   (setq pt (rtos pt 2 2)))
	  ((< pt 10)  (setq pt (strcat "+00" (rtos pt 2 2))))
	  ((< pt 100) (setq pt (strcat "+0" (rtos pt 2 2))))
	  (t (setq pt (strcat "+" (rtos pt 2 2))))
	  );;cond
	(setq pd (mapcar '+ pd '(-1.5 0.5)))
	(command "text" "ml" pd 2.75 90 pt)
	(setvar "osmode" 33)
	);;progn
      );;if
    );;while
  );;end file
;;lc2---------
(defun c:lc2 (/ bl gh p p1 pd pd1 pt)
  (setq bl (getreal "\n绘图比例:"))
  (if (null bl) (setq bl 5.0))
  (setq bl (/ 10.0 bl))
  (setq gh (getstring "\n冠号："))
  (setq gh (strcase gh))
  (setvar "osmode" 33)
  (setq p (getpoint "\n捕捉点:"))
  (setq p1 (getreal "\n输入捕捉点里程:"))
  (setq pd t)
  (while pd
    (setq pd (getpoint "\n里程标注点:"))
    (if (null pd) (setq pd nil)
      (progn
	(setq pd1 pd)
	(setvar "osmode" 0)
	(setq pt (- (car pd) (car p)))
	(setq pt (/ pt bl))
	(setq pt (+ pt p1))
	(setq pt (strcat gh (rtos pt 2 2)))
	(setq pd (mapcar '+ pd '(0 2)))
	(setq pd1 (mapcar '+ pd '(0 3)))
	(command "line" pd1 pd "")
	(command "text" "ml" pd1  90 pt)
	(setvar "osmode" 33)
	);;progn
      );;if
    );;while
  );;end file
;;;;end 里程标
;;;
;;;begin 标高标注程
(defun c:bg1 (/ bl p p1 pd1 pd p01 p02 pt)
  ;;(command "style" "xsy" "italc1,fs" 0 0.75 0 "n" "n" "n")
  (setq bl (getreal "\n绘图比例:"))
  (if (null bl) (setq bl 5.0))
  (setq bl (/ 10.0 bl))
  (setvar "osmode" 33)
  (SETQ P (getpoint "\n捕捉基点:"))
  (setq p1 (getreal "\n输入捕捉基点标高:"))
  (setq pd t)
  (while pd
    (setvar "osmode" 33)
    (setq pd (getpoint "\n标高标注点:"))
    (if (null pd) (setq pd nil)
      (progn
	(setvar "osmode" 0)
	(setq pt (- (nth 1 pd) (nth 1 p)))
	(setq pt (/ pt bl))
	(setq pt (+ pt p1))
	(setq pt (rtos pt 2 2))
	;(setq pd1 pd)
	;(setq pd (mapcar '+ pd '(-3 0)))
	;(command "line" pd1 pd "")
	(setq p01 (mapcar '+ pd '(1.5 4)))
	(setq p02 (mapcar '+ pd '(-1.5 4)))
	(command "pline" pd p01 p02 pd "")
	(setq pd (mapcar '+ pd '(0 7)))
	(command "text" "m" pd 4 0 pt)
	;(command "text" "br" pd 4.5 0 pt)
	);;progn
      );;if
    );;while
  );;end file
;;----------
(defun c:bg2 (/ bl p p1 pd1 pd p01 p02 pt)
  ;;(command "style" "xsy" "italc1,fs" 0 0.75 0 "n" "n" "n")
  (setvar "osmode" 33)
  (setvar "blipmode" 0)
  (command "linetype" "s" "continuous" "")
  (setq bl (getreal "\n绘图比例:"))
  (if (null bl) (setq bl 5.0))
  (setq bl (/ 10.0 bl))
  (setq p (getpoint "\n捕捉基点:"))
  (setq p1 (getreal "\n输入捕捉基点标高:"))
  (setq pd t)
  (while pd
    (setq pd (getpoint "\n标高标注点:"))
    (if (null pd) (setq pd nil)
      (progn
	(setvar "osmode" 0)
	(setq pt (- (nth 1 pd) (nth 1 p)))
	(setq pt (/ pt bl))
	(setq pt (+ pt p1))
	(setq pt (rtos pt 2 0))
	(setq pd1 pd)
	(setq pd (mapcar '+ pd '(-3 0)))
	(command "color" 4)
	(command "line" pd1 pd "")
	(command "color" 7)
	(command "text" "br" pd 4.5 0 pt)
	(setvar "osmode" 33)
	);;progn
      );;if
    );;while
  );;end file
;;;--------
;;;;end 标高标
;;;

;;;
;;
;;
;;
;;;begin sw----------sw水文标注程
(defun c:sw (/ p0 p1 p2 p3 bl pn1 pn2 pn p01 p02 dw)
  ;(command "style" "xsy" "italc1,fs" 0 0.75 0 "n" "n" "n")
  (command "layer" "m" "sw"  "")
  (command "linetype" "s" "continuous" "")
  (command "color" 7)
  (setvar "osmode" 33)
  (setq p0 (getpoint "\n 选择基点： "))
  (setq pn0 (getreal "\n 输入基点标高数据:"))
  (setq bl (getreal "\输入图上比例："))
  (setq bl (/ 10 bl))
  (setq p3 t)
  (while p3
    (setvar "osmode" 33)
    (setq p3 (getpoint "\n 选择标注位置： "))
    (if (null p3) (setq p3 nil)
      (progn
	(setvar "osmode" 0)
	(setq pn2 (getreal "\n 输入水位标高标高数据:"))
	(setq pn (- pn2 pn0))
	(setq pn (* bl pn))
	(setq pn (+ pn (nth 1 p0)))
	(setq p1 (list (nth 0 p3) pn))
	(setq p01 (mapcar '+ p1 '(0.7 2)))
	(setq p02 (mapcar '+ p1 '(-0.7 2)))
	(command "pline" p1 p01 p02 p1 "")
	(setq p01 (mapcar '+ p1 '(-4 0)))
	(setq p02 (mapcar '+ p1 '(23 0)))
	(command "pline" p01 p02 "")
	(setq p01 (mapcar '+ p1 '(-2.5 -1)))
	(setq p02 (mapcar '+ p1 '(2.5 -1)))
	(command "pline" p01 p02 "")
	(setq p01 (mapcar '+ p1 '(-1.5 -2)))
	(setq p02 (mapcar '+ p1 '(1.5 -2)))
	(command "pline" p01 p02 "")
	(setq p2 (mapcar '+ p1 '(1 0.7)))
	(setq pn2 (rtos pn2 2 2))
	(initget 7 "1 2 3 4")
	(setq dw (getkword "选择水位标注1-最高洪水位 2-百年水位 3-测时水位 4-施工水位:"))
	(cond
	  ((= dw "1") (command "text" "bl" p2 3 0 (strcat "最高洪水位:" pn2 "m")))
	  ((= dw "2") (command "text" "bl" p2 3 0 (strcat "百年水位:" pn2 "m")))
	  ((= dw "3") (command "text" "bl" p2 3 0 (strcat "测时水位:" pn2 "m")))
	  ((= dw "4") (command "text" "bl" p2 3 0 (strcat "施工水位:" pn2 "m")))
	  
	  );;cond
	);;progn
      );;if
    );;while
  );;;

;;;;水位标注程
;;;
;;;
;;;
;;;桥涵横断面、涵洞断面绘制程
(defun hdm ()
  (setq  f nil)
  (while (null f)
    (setq fname (getstring "\n 输入线/桥/涵/隧横断面数据文件名<不含扩展名 .dat>:"))
    (setq f (open (strcat fname ".dat") "r"))
    (setq fal (null f))
    (while fal
      (princ (strcat "\n File文件 " fname ".dat 未找到not found!!!"))
      (setq fal nil)
      );;;while1
    ); while2
  (setq fname nil fal nil)
  ;;;;---------读文
  (setq  tmp () str t)
  (while  str
    (setq str (read-line f))(princ str)
    (if str (setq tmp (cons str tmp)))
    )
  (close f)
  (setq tmp (reverse tmp))
  (setq i 0  tmp1 () n (length tmp))
  (repeat n
    (pcc (nth i tmp))
    (setq tmp1 (cons pl tmp1))
    (setq i (+ i 1))
    );;;
  (setq tmp1 (reverse tmp1))
  (setq i nil n nil pl nil tmp nil)
  );;;end file
;;;;;---------------
;;;;
(defun c:hddm ()
  ;;数据文件断面中心里程、标高、交角、水流方向、转点、距