桥纵断面.lsp

画桥址断面的lisp源代码

  (command "style" "xsy" "italc1,fs" 0 0.75 0 "n" "n" "n")
  (setvar "angbase" 0)
  (setvar "angdir" 0)
  (setvar "aunits" 0)
  (setvar "ltscale" 1)
  (setvar "celtype" "continuous")
  (setvar "osmode" 0)
  (command "layer" "m" "dm"  "")
  (command "linetype" "s" "continuous" "")
  (hdm)
  (setq n (length tmp1))
  (setq n (fix (/ n 3)))
  (setq i 0  ii 1 pp '(0 0))
  (setq  p (list 350 150))
  (setq pstr (list 710 28))
  (setq psx (list 730 12))
  (repeat n
    ;;;(setq p01 (polar p (* 0.5 pi) 7))
    (setq p02 (polar p (* 0.5 pi) 83))
    (setq p03 (polar p (* 0.5 pi) 80))
    (setq p031 (polar p03 0 10))
    (setq p032 (polar p03 pi 10))
    (setq p04 (polar p (* 0.5 pi) 70))
    (command "color" 2)
    (command "line" p031 p032 "")
    (command "line" p03 p04 "")
    (setq p032 (polar p03 pi 100))
    (command "color" 7)
    (setq p1 (nth 0 p) p2 (nth 1 p))
    (setq l1 (nth i tmp1) l2 (nth (+ i 1) tmp1) l3 (nth (+ i 2) tmp1))
    (setq l11 (nth 0 l1) l12 (nth 1 l1) l13 (nth 2 l1)
	  l14 (nth 3 l1) l15 (nth 4 l1) l16 (nth 5 l1))
    (if l15 (setq zd (list (read l16) 0)) (setq zd '(0 0)))
    (if l15 (setq l15 (strcase l15)))
    (setq zd0 zd)
    (setq zd (mapcar '* zd '(5 0)))
    (setq l122 (read l12))
    (setq l122 (* l122 5))
    (setq l122 (rem l122 50))
    (setq zd (mapcar '+ zd (list 0 l122)))
    (setq l11 (strcase l11))
    (setq p011 (mapcar '+ p zd))
    (command "color" 7)
    (setq p0111 (mapcar '+ p011 '(1.5 4)))
    (setq p0112 (mapcar '+ p011 '(-1.5 4)))
    ;;(setq p03 (mapcar '+ p011 '(0 7)))
    (command "pline" p011 p0111 p0112 p011 "")
    (setq p012 (polar p011 (* 0.5 pi) 7))
    (cond
      ((= (nth 0 zd0) 0) (command "text" "m" P012 4 0 (strcat l12)))
      (t (command "text" "m" P012 4 0 (strcat l15 " " l12)))
      )
    (command "text" "m" p02 4 0 l11)
    ;;;
    (setq p03 (polar p (* 1.5 pi) 100))
    (setq p033 (polar p03 (* 1.5 pi) 35))
    (setq p03y1 (polar p03 (* 0.5 pi) 30) p03y2 (polar p03 (* 1.5 pi) 30))
    (if (null l13) (setq l13 0))
    (command "text" "m" p033 4 0 (strcat "与法线交角： "l13 "度"))
    (setq l13 (read l13))
    (setq l13 (/ l13 180.0))
    (setq l13 (* l13 pi))
    (setq p03x1 (polar p03 l13 40) p03x2 (polar p03 (+ l13 pi) 40))
    (command "color" 4)
    (setq pang1 (angle p03x1 p03x2))
    (setq pang2 (angle p03x2 p03x1))
    (command "line" p03x1 p03x2 "")
    (command "line" p03y1 p03y2 "")
    (cond
      ((= l14 "y") (setq p03xx (polar p03x1 (+ 0.26 pang1) 10))(command "line" p03xx p03x1 ""))
      ((= l14 "z") (setq p03xx (polar p03x2 (+ 0.26 pang2) 10))(command "line" p03xx p03x2 ""))
      (t (princ))
      );;;
    
    ;;;;;;;;;;;;;;;l2--------l2 begin
    (setq  x nil i0 0 ls () lx2 () l '(0 0))
    (setq m (length l2))
    (setq m (fix (/ m 2)))
    (setq ll (list p1 p2))
    (repeat m
      (setq xx1 (read (nth i0 l2))
	    xx3 (nth i0 l2)
	    xx2 (read (nth (+ i0 1) l2))
	    xp (* pi (/ xx2 180.0))
	    xt (numberp xx1))
      (cond
	(xt (if (= l14 "j") (setq x  (abs (* xx1 (sin xp))) y (* xx1 (cos xp)) l (list x y))
	      (setq x  xx1 y  xx2 l (list x y))))
	((null xt) (setq  x  (read (substr xx3 2))
			  y0  xx2
			  l (mapcar '+ l (list x y0))))
	);;;;cond
      (if l (setq l0 (mapcar '* l '(-5 5))))
      (if l (setq l0 (mapcar '+ l0 ll)))
      (if l0 (setq lx2 (cons l0 lx2)))
      (if (< x 0)
	(progn
	  (setq ls () ix 2 nx (length lx2))
	  (princ nx)
	  (setq ls1 (nth 0 lx2) ls2 (nth 1 lx2))
	  (setq nx (- nx 2))
	  (repeat nx
	    (setq ls (cons (nth ix lx2) ls))
	    (setq ix (+ ix 1))
	    )
	  (setq ls (reverse ls))
	  (setq ls (cons ls1 ls) ls (cons ls2 ls))
	  (setq lx2 ls))
	);;if
      (setq i0 (+ i0 2))
      )
    ;;
    (setq x nil i0 0 ls () lx3 () l '(0 0))
    (setq m (length l3))
    (setq m (fix (/ m 2)))
    (setq ll (list p1 p2))
    (repeat m
      (setq xx1 (read (nth i0 l3))
	    xx3 (nth i0 l3)
	    xx2 (read (nth (+ i0 1) l3))
	    xp (* pi (/ xx2 180.0))
	    xt (numberp xx1))
      (cond
	(xt (if (= l14 "j") (setq x  (abs (* xx1 (sin xp))) y (* xx1 (cos xp)) l (list x y))
	      (setq x  xx1 y  xx2 l (list x y))))
	((null xt) (setq  x  (read (substr xx3 2))
			  y0  xx2
			  lxs l
			  l (mapcar '+ l (list x y0))))
	);;;;cond
      (if l (setq l0 (mapcar '* l '(5 5))))
      (if l (setq l0 (mapcar '+ l0 ll)))
      (if l0 (setq lx3 (cons l0 lx3)))
      (if (< x 0)
	(progn
	  (setq ls () ix 2 nx (length lx3))
	  (setq ls1 (nth 0 lx3) ls2 (nth 1 lx3))
	  (setq nx (- nx 2))
	  (repeat nx
	    (setq ls (cons (nth ix lx3) ls))
	    (setq ix (+ ix 1))
	    )
	  (setq ls (reverse ls))
	  (setq ls (cons ls1 ls) ls (cons ls2 ls))
	  (setq lx3 ls))
	);;if
      (setq i0 (+ i0 2))
      )
    (setq lx3 (reverse lx3))
    ;;;
    ;;;
    ;;;
    (setq ps (list p1 p2) ps (list ps))
    (setq lst  (append lx2 ps lx3));;;;;;;;;;;;
    (command "color" 4)
    (command "pline")
    (foreach x lst (if x (command (mapcar '+ x zd))))
    (command)
    (command "color" 7)
    (setq p (polar p 0 800))
    (tk1 pp)
    ;;;;;(command "insert" "d:\\xsy\\tk" pp "" "" "")
    (command "layer" "m" "tk"  "")
    (command "text" "m" pstr 5 0 (strcat l11 "  涵轴断面"))
    (command "text" "ml" psx 4 0 "1:200")
    (command "layer" "m" "dm" "")
    (setq pp (polar pp 0 800))
    (setq pstr (polar pstr 0 800))
    (setq psx (polar psx 0 800))
    (setq i (+ i 3))
    (setq ii (+ ii 1));;if
    );;;repeat
  (command "layer" "m" "0"  "")
  (command "linetype" "s" "continuous" "")
  (setq ii (- ii 1))
  (setq ii (itoa ii))
  (prompt (strcat "共有" ii "根断面"))
  );;;end 涵洞断面程
;;;;;桥横断
(defun c:qhdm ()
  ;;数据文件断面中心里程、标高、墩台号、经纬仪j、转点、距
  (command "style" "xsy" "italc1,fs" 0 0.75 0 "n" "n" "n")
  (setvar "angbase" 0)
  (setvar "angdir" 0)
  (setvar "aunits" 0)
  (setvar "ltscale" 1)
  (setvar "celtype" "continuous")
  (setvar "osmode" 0)
  (command "layer" "m" "dm"  "")
  (command "linetype" "s" "continuous" "")
  (hdm)
  (setq qiao (getstring "\n 输入桥名: "))
  (setq zx (getstring "\n 输入桥中心里程:"))
  (setq kk (getstring "\n 输入孔跨式样:"))
  (setq zx (strcase zx))
  (setq kk (strcase kk))
  (setq n (length tmp1))
  (setq n (fix (/ n 3)))
  (setq i 0  ii 1 pp '(0 0))
  (setq  p (list 200 150))
  (setq pstr (list 710 28))
  (setq psx (list 730 12))
  (repeat n
    (setq p02 (polar p (* 0.5 pi) 83))
    (setq p03 (polar p (* 0.5 pi) 80))
    (setq p031 (polar p03 0 20))
    (setq p032 (polar p03 pi 20))
    (setq p04 (polar p (* 0.5 pi) 70))
    (command "color" 2)
    (command "line" p031 p032 "")
    (command "line" p03 p04 "")
    (command "color" 7)
    (setq p1 (nth 0 p) p2 (nth 1 p))
    (setq l1 (nth i tmp1) l2 (nth (+ i 1) tmp1) l3 (nth (+ i 2) tmp1))
    (setq l11 (nth 0 l1) l12 (nth 1 l1) l13 (nth 2 l1)
	  l14 (nth 3 l1) l15 (nth 4 l1) l16 (nth 5 l1))
    (if l15 (setq zd (list (read l16) 0)) (setq zd '(0 0)))
    (if l15 (setq l15 (strcase l15)))
    (setq zd0 zd)
    (setq zd (mapcar '* zd '(5 0)))
    (setq l122 (read l12))
    (setq l122 (* l122 5))
    (setq l122 (rem l122 50))
    ;(if (>= l122 40) (setq l122 (- l122 50)))
    (setq zd (mapcar '+ zd (list 0 l122)))
    (setq l11 (strcase l11))
    (setq p011 (mapcar '+ p zd))
    (command "color" 7)
    (setq p0111 (mapcar '+ p011 '(1.5 4)))
    (setq p0112 (mapcar '+ p011 '(-1.5 4)))
    ;;(setq p03(mapcar '+ p011 '(0 7)))
    (command "pline" p011 p0111 p0112 p011 "")
    (setq p012 (polar p011 (* 0.5 pi) 7))
    (cond
      ((= (nth 0 zd0) 0) (command "text" "m" P012 4 0 l12))
      (t (command "text" "m" P012 4 0 (strcat l15 " " l12)))
      )
    (setq nt nil lt nil lt1 nil)
    (if l13 (setq nt (strlen l13) lt (substr l13 nt) lt1 (substr l13 1 (- nt 1))))
    (setq lt (strcase lt))
    (cond
      ((= lt "Q")(command "text" "m" p02 4 0 (strcat l11 "  " lt1 "号台前")))
      ((= lt "H")(command "text" "m" p02 4 0 (strcat l11 "  " lt1 "号台尾")))
      (l13  (command "text" "m" p02 4 0 (strcat l11 "  " l13 "号墩")))
      ((null l13) (command "text" "m" p02 4 0 l11))
      );;;
    ;;;;;;;;;;;;;;;l2--------l2 begin
    (setq  x nil i0 0 ls () lx2 () l '(0 0))
    (setq m (length l2))
    (setq m (fix (/ m 2)))
    (setq ll (list p1 p2))
    (repeat m
      (setq xx1 (read (nth i0 l2))
	    xx3 (nth i0 l2)
	    xx2 (read (nth (+ i0 1) l2))
	    xp (* pi (/ xx2 180.0))
	    xt (numberp xx1))
      (cond
	(xt (if (= l14 "j") (setq x  (abs (* xx1 (sin xp))) y (* xx1 (cos xp)) l (list x y))
	      (setq x  xx1 y  xx2 l (list x y))))
	((null xt) (setq  x  (read (substr xx3 2))
			  y0  xx2
			  l (mapcar '+ l (list x y0))))
	);;;;cond
      (if l (setq l0 (mapcar '* l '(-5 5))))
      (if l (setq l0 (mapcar '+ l0 ll)))
      (if l0 (setq lx2 (cons l0 lx2)))
      (if (< x 0)
	(progn
	  (setq ls () ix 2 nx (length lx2))
	  (princ nx)
	  (setq ls1 (nth 0 lx2) ls2 (nth 1 lx2))
	  (setq nx (- nx 2))
	  (repeat nx
	    (setq ls (cons (nth ix lx2) ls))
	    (setq ix (+ ix 1))
	    )
	  (setq ls (reverse ls))
	  (setq ls (cons ls1 ls) ls (cons ls2 ls))
	  (setq lx2 ls))
	);;if
      (setq i0 (+ i0 2))
      )
    ;;
    (setq x nil i0 0 ls () lx3 () l '(0 0))
    (setq m (length l3))
    (setq m (fix (/ m 2)))
    (setq ll (list p1 p2))
    (repeat m
      (setq xx1 (read (nth i0 l3))
	    xx3 (nth i0 l3)
	    xx2 (read (nth (+ i0 1) l3))
	    xp (* pi (/ xx2 180.0))
	    xt (numberp xx1))
      (cond
	(xt (if (= l14 "j") (setq x  (abs (* xx1 (sin xp))) y (* xx1 (cos xp)) l (list x y))
	      (setq x  xx1 y  xx2 l (list x y))))
	((null xt) (setq  x  (read (substr xx3 2))
			  y0  xx2
			  lxs l
			  l (mapcar '+ l (list x y0))))
	);;;;cond
      (if l (setq l0 (mapcar '* l '(5 5))))
      (if l (setq l0 (mapcar '+ l0 ll)))
      (if l0 (setq lx3 (cons l0 lx3)))
      (if (< x 0)
	(progn
	  (setq ls () ix 2 nx (length lx3))
	  (setq ls1 (nth 0 lx3) ls2 (nth 1 lx3))
	  (setq nx (- nx 2))
	  (repeat nx
	    (setq ls (cons (nth ix lx3) ls))
	    (setq ix (+ ix 1))
	    )
	  (setq ls (reverse ls))
	  (setq ls (cons ls1 ls) ls (cons ls2 ls))
	  (setq lx3 ls))
	);;if
      (setq i0 (+ i0 2))
      )
    (setq lx3 (reverse lx3))
    ;;;
    ;;;
    ;;;
    (setq ps (list p1 p2) ps (list ps))
    (setq lst  (append lx2 ps lx3));;;;;;;;;;;;
    (command "color" 4)
    (command "pline")
    (foreach x lst (if x (command (mapcar '+ x zd))))
    (command)
    (command "color" 7)
    (if (= (rem ii 2) 1) (setq p (polar p 0 350)) (setq p (polar p 0 450)))
    (if (= (rem ii 2) 1)
      (progn
	(tk1 pp)
	;;;;;(command "insert" "d:\\xsy\\tk" pp "" "" "")
	(command "layer" "m" "tk"  "")
	(command "text" "m" pstr 4 0 (strcat zx " " kk " " qiao "墩台横断面"))
	(command "text" "ml" psx 4 0 "1:200")
	(command "layer" "m" "dm" "")
	(setq pp (polar pp 0 800))
	(setq pstr (polar pstr 0 800))
	(setq psx (polar psx 0 800))
	)
      )
    (setq i (+ i 3))
    (setq ii (+ ii 1));;if
    );;;repeat
  (setq ii (- ii 1))
  (setq ii (itoa ii))
  (command "layer" "m" "0"  "")
  (command "linetype" "s" "continuous" "")
  (prompt (strcat "共有" ii "根断面"))
  (setq ii nil)
  (terpri)
  );;;end 桥横断面程
;;;
;;;
;;字符串转化为表涵数程序,接口字符串p0,出口为表pl
(defun pcc1 (p0 / n m i s1 p01)
  (setq n (strlen p0) m 1 i 1 pl ())
  (setq p0 (strcase p0))
  (while (< i n)
    (setq s1 (substr p0 i 1))
    (if (or (= s1 "X") (= s1 "+") (= S1 " ") (= S1 ","))
      (progn
	(setq p01 (substR P0 m (- i m)))
	(IF P01 (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
;;;-------------
;;;defun找数据文件并读取数
(defun pcc2 (p0 / pl1 l1 n i)
  (setq n (length (pcc p0)))
  (setq pl1 pl)
  (setq pl2 ())
  (setq i 0)
  (while (< i n)
    (pcc1 (nth i pl1))
    (setq nn (length pl))
    (if (= nn 1) (setq pl (cons 1 pl)))
    (setq pl2 (cons pl pl2))
    (setq i (+ i 1))
    );;while
  (setq n (length pl2))
  (setq i 0 pl ())
  (repeat n
    (setq l1 (nth i pl2))
    (setq i (+ i 1))
    (setq l11 (nth 1 l1))
    (setq pl (cons l11 pl))
    (setq l12 (nth 0 l1))
    (setq pl (cons l12 pl))
    );;repeat
  )
;;;begin kkbz---------kkbz桥梁孔跨布
(DEFUN C:KKBZ (/ bl p pdd p1 p2 plc px py p0 p01 p02 p03 zx p0t p0t1 p0t2)
  (setq pqy nil pqz nil bl nil)
  (setq bl (getreal "\n绘图比例<5>:"))
  (if (null bl) (setq bl 5.0))
  (setq blxs (/ bl 10.0))
  (SETVAR "DIMLFAC" blxs)
  (setq bl (/ 10.0 bl))
  (setvar "osmode" 33)
  (SETQ P (getpoint "\n捕捉点:"))
  (setvar "osmode" 0)
  (setq p1 (getreal "\n输入捕捉点里程:"))
  (setq p2 (getreal "\n输入桥中心里程:"))
  (setq pqz (getstring "\n输入左侧孔跨式样:"))
  (setq pqy (getstring "\n输入右侧孔跨式样:"))
  (if (null (read pqy)) (setq pqy pqz))
  (setq zx (getstring "\n输入冠号:"))
  (setq pqz (strcase pqz))
  (setq pqy (strcase pqy))
  (setq zx (strcase zx))
  (setq pqz (pcc2 pqz))
  (setq pqy (pcc2 pqy))
  (setq n (length pqz))
  (setq n (/ n 2))
  (setq i 0 lz 0)
  (repeat n
    (setq l1 (nth i pqz))
    (setq l2 (nth (+ i 1) pqz))
    (setq ll (* l1 l2))
    (setq lz (+ ll lz))
    (setq i (+ i 2))
    );;桥左
  (setq n (length pqy))
  (setq n (/ n 2))
  (setq i 0 ly 0)
  (repeat n
    (setq l1 (nth i pqy))
    (setq l2 (nth (+ i 1) pqy))
    (setq ll (* l1 l2))
    (setq ly (+ ll ly))
    (setq i (+ i 2))
    );;桥右
  (setq ql (+ lz ly));;桥
  (setq plz (- p2 lz));;zuotai
  (setq ply (+ p2 ly));;yuotai
  (setq n (length pqz))
  (setq n (/ n 2))
  (setq i 0 l 0 lz '(0))
  (repeat n
    (repeat (fix (nth i pqz))
      (setq l1 (nth (+ i 1) pqz))
      (setq l (+ l l1))
      (setq lz (cons l lz))
      );;repeat 1
    (setq i (+ i 2))
    );;repeat 2
  (setq lz (reverse lz))
  (setq lzz ())
  (foreach x lz (setq lzz (cons (+ plz x) lzz)))
  (setq lzz (reverse lzz))
  (setq n (length pqy))
  (setq n (/ n 2))
  (setq  i 0 l 0 ly '(0))
  (repeat n
    (repeat (fix (nth i pqy))
      (setq l1 (nth (+ i 1) pqy))
      (setq l (+ l l1))
      (setq ly (cons l ly))
      );;repeat 1
    (setq i (+ i 2))
    );;repeat 2
  (setq ly (reverse ly))
  (setq lyy ())