b.lsp

此代码为Lisp语言编写

(setq bzg 2 bzjc 2 bzjwc 5.0 bzjk 0.6 bzjj 0.7 bzs 2.0
      bzx 2.0 bznc 4.9 gbr 2.0 gbjc 3 bzd 1.0 bzw 1
      yjgzj 10 r_darc 8 h_rom 4 pw_a 0.3 bg_a 6
      gbh1 6.0 gbc1 8.0 gbc31 5 gbc32 5 gbc4 10
      dj_fdc 800 dj_n 10
)
(setq bl(getvar "USERR4"))
(setq sca_gj(getvar "USERR3"))
(setq Bsca(getvar "userr5"))
(if (= Bsca 0)(setq Bsca 1.0))
(setq sca_a (getreal (strcat "\n输入图幅比例<" (rtos Bsca 2 2) ">:")))
(if (not sca_a)(setq sca_a Bsca))
(setvar "userr5" sca_a)
(foreach x '(bzg bzjc bzjwc bzjk bzjj bzs bzx bznc gbr gbh1 gbc1
             gbc31 gbc32 gbc4 gbjc bzd r_darc h_rom pw_a bg_a)
    (set x (* (eval x) sca_a))
)
(vmon)(setvar "CMDECHO" 0)(regapp "BZ_GJ")(regapp "LBB_JS")
(if (= (getvar "handles") 0)(command "handles" "on"))
(if (not sca_gj)(setq sca_gj 10))
(setq pi2 (/ pi 2) pi3(* pi 1.5) pih(/ pi -2))
(defun tol(l) (/ l (* 0.1 bl)))
(defun pol(p1 al l) (polar p1 al (tol l)))
(defun po2(p1 a1 l) (polar p1 a1 (/ l coat)))
(defun pn2(p1 a1 l) (polar p1 a1 (* l coat)))
(defun po3(p1 a1 l) (polar p1 a1 (tol (/ l coat))))
(defun po4(p1 a1 l) (polar p1 a1 (/ l (cos a1))))
(defun ppt(p1 x y) (list (+ (car p1) x) (+ (cadr p1) y)))
(defun tan(x) (/ (sin x) (cos x)))
(defun tan1(x) (abs (/ (sin x) (cos x))))
(defun b_nc(x1 y1 x2 y2 x0)
;内插数值
	(if (= x1 x2)
               	y1
		(+ (* (/ (- y2 y1 0.0) (- x2 x1 0.0))(- x0 x1 0.0)) y1)
	)
)
(defun vtzh(zh kz ww / zhk zhl)
;桩号转换为字符串
;kz=1时前面加公里桩
        (setq zhk(fix (/ zh 1000))
              zhl(- zh (* zhk 1000))
        )
        (cond
                ((< zhl 10)(setq zhl(strcat "00" (rtos zhl 2 ww))))
                ((< zhl 100)(setq zhl(strcat "0" (rtos zhl 2 ww))))
                (t(setq zhl (rtos zhl 2 ww)))
        )
        (if (= kz 1)
                (strcat "K" (itoa zhk) "+" zhl)
                (strcat zhl)
	)
)
(defun zbzh1(pp zp p0 sal / xx yy)
;坐标系平移到P0点并逆时针旋转SAL角
       (setq xx(- (car pp) (car p0))yy(- (cadr pp) (cadr p0)))
       (list (list (+ (* xx (cos sal)) (* yy (sin sal)))
                   (- (* yy (cos sal)) (* xx (sin sal))))
             (- zp sal))
)
(defun zbzh2(p0 a0 pl al / xx yy) 
;已知局部坐标系原点P0 A0,返回局部坐标系中PL AL的绝对坐标及角度.
       (setq xx(- (* (car pl) (cos a0)) (* (cadr pl) (sin a0)))
             yy(+ (* (cadr pl) (cos a0)) (* (car pl) (sin a0))))
	   (list (list (+ xx (car p0)) (+ yy (cadr p0))) (+ a0 al))
)
(defun zy_lp(p1 p2 pp / aa pf ff)
;判断点PP在直线P1P2的右侧(返回1)左侧(返回-1)或是在直线上(返回0)
       (setq aa(angle p1 p2) pf(car (zbzh1 pp 0 p1 aa)))
       (if (> (cadr pf) 0) (setq ff -1))
       (if (= (cadr pf) 0) (setq ff 0))
       (if (< (cadr pf) 0) (setq ff 1))
	   ff
)
(defun lpqhz(p1 ang dis p3 / p0 p2 ll xx)
;判断点P3到线段P1P2的投影点位置
    ;-1:在P1后方,0在P1P2之间,1在P2前方
       (setq p2(polar p1 ang dis))
       (setq p0(car (zbzh1 p3 0 p1 ang)))
       (setq xx(car p0) xx(kj_my xx 0 0) xx(kj_my xx dis dis))
       (cond ((< xx 0) -1)
             ((> xx dis) 1)
			 (t (list (car p0) (abs (cadr p0))))
	   )
)
(defun cpqhz(p1 p2 pc r zy p3 / r p01 p02 a01 a02 a1 a2 a3 a12 a00 dc3 ff)
;判断点P3到弧线P1P2的投影点位置
       ;-1:在P1后方,0在P1P2之间,1在P2前方
       (setq a1(angle pc p1) a2(angle pc p2) a3(angle pc p3)
             p01(polar pc a3 r) p02(polar pc (+ a3 pi) r)
             dc3(distance pc p3))
       (setq a12(- a1 a2) a01(- a1 a3) a02(- a1 a3 pi)
             a12(bjr_a (* zy a12)) a01(bjr_a (* zy a01)) a02(bjr_a (* zy a02)))
       (setq a12(kj_my a12 (* pi 2) 0) a00(bjr_a (+ (/ a12 2) pi))
             a02(kj_my a02 (* pi 2) 0)  a01(kj_my a01 (* pi 2) 0)
             a01(kj_my a01 a12 a12) a02(kj_my a02 a12 a12)
             a01(kj_my a01 a00 a00) a02(kj_my a02 a00 a00))
       (if (<= a02 a12)(setq ff(list (* r a02) (+ dc3 r))))
       (cond ((<= a01 a12) (setq ff(list (* r a01) (abs (- r dc3)))))
             ((and (< a01 a00) (not ff))(setq ff 1))
             ((not ff)(setq ff -1)))
	   ff
)
(defun dislp(pt1 pt2 p1 / al p2)
;点到直线距离
       ;返回由垂直点及距离构成的表
       (setq al(+ (/ pi 2) (angle pt1 pt2))
			 p2(polar p1 al 1) p2(inters p1 p2 pt1 pt2 nil))
	   (list p2 (distance p1 p2))
)
(defun gjdw_a(x)
;求钢筋单位重,x:钢筋直径(mm).
	(cond ((= x 28) 4.833)
	  ((= x 30) 5.548)
	  ((= x 36) 7.989)
	  ((= x 38) 8.902)
	  ((= x 40) 9.863)
	  (t (fin (* x x pi 0.25 0.785 0.01) 3))
    )
)
(defun dtr(a) (* pi (/ a 180.0)));度化为弧度
(defun rtd(a) (* 180.0 (/ a pi)));弧度化为度
(defun ppt(p1 x y) (list (+ (car p1) x) (+ (cadr p1) y)))
;将点p1坐标分别加x,y.
(defun fin(x n) (read (rtos x 2 n)))
;将x精确到小数点后n位.
(defun asin(x)(if (< x 1) (atan (/ x (sqrt (- 1 (* x x))))) pi2))
;x的反正玄值(弧度)
(defun Cosh(x)
        (/ (+ (exp x) (exp (- x))) 2.0)
)
(defun dv(l d)(mapcar '(lambda (x) (/ x 1.0 d)) l))
;将表l各值分别除以d.
(defun lth(l n v / vj nn fl)
;将表l的第n项换成v.v=999时则去除l的第n项,v为表时则将l的第n项换成v内各项.
	(setq nn 0)
	(repeat (length l)
		(if (= nn n)(setq vj v)(setq vj(nth nn l)))
		(if (/= (type vj) 'list)(setq vj (list vj)))
		(if (= (nth 0 vj) 999)(setq vj nil))
		(setq fl(append fl vj) nn(1+ nn))
	)
	fl
)
(defun lth(l n v / vj nn fl)
       ;将表L第N位改为V
       (setq nn 0)
       (repeat (length l)
       (if (= nn n)(setq vj v)(setq vj(nth nn l)))
       (setq fl(append fl (list vj)) nn(1+ nn)))fl
)
(defun lhw(l n1 n2 / vj nn fl)
;将表l第n1项和n2项互换.
	(setq nn 0)(repeat (length l)
	(cond ((= nn n1)(setq vj(nth n2 l)))
		  ((= nn n2)(setq vj(nth n1 l)))
		  (t(setq vj(nth nn l)))
	)
	(setq fl(append fl (list vj)) nn(1+ nn)))
	fl
)
(defun rtos1(v1 bzw1 / s nn co i)
	(setq s(rtos v1 2 bzw1) nn(strlen s) co (substr s nn) i 0)
	(while (and (= co "0") (< i bzw1))
		(setq i(+ i 1)nn(- nn 1) co(substr s nn 1))
	)
	(cond
		((= i 0) s)
		((= i bzw1) (substr s 1 (- nn 1)))
		(t (substr s 1 nn))
	)
)
(defun ltype( / f s ltd l cl lp ct sl)
       (setq cl(getvar "clayer") lp 1 f 1)
       (while lp
              (setq s(tblnext "layer" f))
                    (if (= (cdr (assoc 2 s)) cl)
                        (setq ct(cdr (assoc 6 s)) lp nil))
              (setq f nil))
       (if (= ct "CONTINUOUS") (setq ct "32767")
           (progn
              (setq ct(strcat "*" ct))
              (setq f(open (findfile "acad.lin") "r") lp 1)
              (while lp
                     (setq s(read-line f))
                     (if (= (substr s 1 (strlen ct)) ct)
                         (setq ltd(substr (read-line f) 3) lp nil)))
              (close f)
              (setq ct "" s1 "")                     
              (while (/= ltd "")
                     (setq s(substr ltd 1 1) ltd(substr ltd 2))
                     (cond((and (= s ".")
                                (or(= s1 "") (= s1 ",")(= s1 "-")))
                            (setq ct(strcat ct "0.")))
                           ((= s ",")(setq ct(strcat ct " ")))
                           (t(setq ct(strcat ct s))))
                     (setq s1 s))
              ))
			  (read (strcat "(" ct ")")))
(defun curv1(f from to ss / l n s n1 n2 len)
  ;F:函数表达式,F(L)返回L处XY构成的表
  ;FROM,TO:函数F的起终点
  ;SS:步长
  ;BP,AL:曲线起点坐标,角度
       (setq l(ltype) n(length l) s(getvar "ltscale") n1 0)
       (setq from (float from) to (float to))
       (while (< from to)
              (setq ft from len (* s (nth n1 l)))
              (cond ((> len 0.0)
                     (if (> ss len) (setq ss len))
                     (setq n2 0)(command "pline")
                     (while (and (< n2 len)(<= from to))
                            (command (car (f from)))
                            (setq n2(+ n2 ss) ft from from(+ ss from))
                            (if(and (< (- from ss) to)(> from to))
                               (setq from to ft from)))
                     (setq from(+ (- from n2) len))
                     (if (< from to)(command (car (f from))))
                     (command ""))
                    ((< len 0.0)(setq from(- from len)))
                    ((= len 0)(command "point" (car (f from))))) ;end of cond
              (setq n1(1+ n1))
              (if (= n1 n)(setq n1 0))) ;end of while
       (if (< ft to)(command "pline" (car (f ft)) (car (f to)) ""))
	   (princ)
)
(defun read-list(f / str)
;从由F打开的文件中读入一行字符串并转化为表(以" "为分隔符)
	(setq str(read-line f))
    (if str
		(read (strcat "(" str ")"))
    )
)                                                           
(defun px_a(ll / nn n1 n2 fl nj xj)
;;将表l由大到小排序.
	(setq nn(length ll) n1 0 fl ll)
	(repeat (- nn 1)
		(setq nj n1 n2(1+ n1))
		(repeat (- nn n1 1)
			(if (> (nth n2 fl) (nth nj fl))
				(setq nj n2))
				(setq n2(1+ n2))
			)
			(if (/= nj n1)
				(setq fl(lhw fl nj n1))
			)
			(setq n1(1+ n1)
		)
	)
	fl)
(defun displ(p1 pt1 pt2 / al p2)
;点p1到直线pt1,pt2的距离.
	(setq al(+ pi2 (angle pt1 pt2))
              p2(polar p1 al 1) p2(inters p1 p2 pt1 pt2 nil)
	)
	(list p2 (distance p1 p2))
)
(defun displ1(p1 al pt1 pt2 / p2 pin)
;点p1按al角到直线pt1,pt2的距离.
    (setq p2(polar p1 (dtr al) 1))
    (list (setq pin(inters p1 p2 pt1 pt2 nil)) (distance pin p1))
)
(defun dhp(jd hp / al jd1 jd2 jd3 jdc)
;绘坡度
        (setq hp1(atan hp))
        (if (> hp 0) (setq al(+ pi hp1)) (setq al hp1))
	(setq jd1(polar jd al -6) jd2(polar jd1 al 10)
		  jd3(polar jd2 al bzjc) jdc(ppt jd 0 bzjj)
	)
	(command "pline" jd1 "W" 0 0 jd2 "W" bzjk 0 jd3 "")
        (command "text" "C" jdc bzg (rtd hp1) (strcat (rts (* 100 (abs hp))) "%"))
)
(defun stsl1(s / ll_a n1_a n_a v1_a v2_a co_a loop_a)
;将字符串s转化为表.如字串含x号,则x号前为基数,x号后为个数.
	(setq n1_a(strlen s) loop_a "T" n_a 1)
	(while (and (< n_a n1_a) loop_a)
		(setq co_a(substr s n_a 1))
		(if (= (strcase co_a) "X")
			(setq v1_a(stv (substr s 1 (- n_a 1)))
				  v2_a(stv (substr s (+ 1 n_a) (- n1_a n_a)))
				  loop_a nil)
		)
		(setq n_a(1+ n_a))
	)
	(if loop_a (setq ll_a (list (stv s)))
	(repeat (fix v2_a) (setq ll_a(append ll_a (list v1_a)))))
)
(defun stsl(s n_a / l1_a l2_a n1_a n2_a ss_a)
;将字符串或数值s转化为表.如字串含x号,则x号前为基数,x号后为个数.
;n_a:表长度.如转化的表长小于n_a,则用最后一个数补足.
	(cond ((= (type s) 'str)
               (setq l1_a(stl s)))
              (t (setq l1_a(list (rtos (rtv s) 2 4))))
	)
	(setq n1_a(length l1_a) n2_a 0 l2_a nil)
	(repeat n1_a
		(setq ss_a(nth n2_a l1_a))
		(setq l2_a(append l2_a (stsl1 ss_a)))
		(setq n2_a(1+ n2_a))
	)
	(setq n2_a(length l2_a))
	(if (< n2_a n_a)
		(repeat (- n_a n2_a) (setq l2_a(append l2_a (list (last l2_a)))))
		l2_a
	 )
)
(defun vln(l n / vv nn)
;求表l的前n项和.
	(setq vv 0 nn 0)
	(repeat n (setq vv(+ (nth nn l) vv) nn(1+ nn)))
	vv
) 
(defun rts(x)
;将x转化为字符串.
;x可为字符串,数值.
	(cond ((= (type x) 'str) x)
		  ((or (= (type x) 'sym) (= (type x) 'list)) (rts (eval x)))
		  (t (if (= (type x) 'int) (itoa x) (rtos x 2 bzw)))
	)
)
(defun rtv(x)
;将x转化为数值.
;x可为字符串,数值.
	(cond
		((= (type x) 'str) (stv x))
		((or (= (type x) 'sym) (= (type x) 'list)) (rtv (eval x)))(t x)
	)
)
(defun ss__a(s / n_a)
;将表达式字符串s求值并转化为字符串
;若字符串以"="结尾则只去掉"=".
	(setq ff_a(substr s (setq n_a(strlen s)) 1))
	(if (= ff_a "=")
		(substr s 1 (- n_a 1))
		(rts (stv s))
	)
)
(defun ss0__a(s / n_a sb_a se_a)
;去掉字符串尾的"="和首尾括号.
	(if (= s "")(setq s " "))
	(setq se_a(substr s (setq n_a(strlen s)) 1))
	(cond
		((= se_a "=")
		 (substr s 1 (- n_a 1))
		)
		((str_be s)
		 (ss0__a(substr s 2 (- n_a 2)))
		)
		(t
		 s
		)
	)
)
(defun str_be(s / n_a sb_a se_a n[] co_a i_a)
;检查字符串s是否是否首尾多余括号
	(if (= s "")(setq s " "))
	(setq se_a(substr s (setq n_a(strlen s)))sb_a(substr s 1 1) n[] 1 i_a 1)
	(if (and (= sb_a "(")(= se_a ")"))
		(while (and (> n[] 0) (< i_a n_a))
			(setq i_a(1+ i_a) co_a(substr s i_a 1))
			(if (= co_a ")") (setq n[](- n[] 1)))
			(if (= co_a "(") (setq n[] (+ n[] 1)))
		)
	)
	(and (= n[] 0)(= i_a n_a))
)
(defun ss1__a(s / n_a ff_a)
;将x转化为字符串并去掉字符串尾的"]".
;x可为字符串,数值.
	(setq ff_a(substr s (setq n_a(strlen s)) 1))